Excel - Copy contents of some cells in Sheet2 into rows with same suburb & postcode in Sheet1

The attached file contains 2 worksheets.
Sheet 1 contains 3 columns - Local Zone numbers, Postcode numbers, Suburb names. For each Postcode/Suburb combination there are many Local Zone numbers. There are also different suburb names against the same postcode number.

Sheet 2 contains 4 columns - Postcode, Suburb, Masthead name, Colour code. This list also has different suburb names against the same postcode.

The requirement is to copy the masthead name and colour code from Sheet2 into Sheet1, into the same row as the Postcode/Suburb combination, and repeat it as many times as the Postcode/Suburb combination appears.
And where there is another Masthead/Colour code for the same Postcode/Suburb, include this in the next columns.

Part of the first two masthead/colour codes have been copied manually to indicate the required result.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Can it be done in vba?
Ejgil HedegaardCommented:
It can be done by a few filtering, copying, and remove duplicates.

Something is wrong with the data.
Only 2 Masthead types, Central Courier, and Wentworth Courier, where result has 9.
There are no Masthead values below row 191 in the data.

Most of the Postcode-Suburbs-Masthead on the result sheet are not on the input sheet.
Some Suburbs are not there at all.
Examples row 5, Town Hall, row 14, East Sydney

Please upload a new sheet with all data.
It is not the good task for excel. Only few seconds in Access, but few minutess in Excel. Look at sample (allow macros and press button on first worksheet)
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Ejgil HedegaardCommented:
Sorry, misunderstood the requirement.
Skip my comment.
Ejgil HedegaardCommented:
You are right, Excel is not the best tool for this, but possible, and the speed can be increased significantly by using arrays instead of working with cells on the sheets.
See sample where the code is changed to use arrays.
It completes in less than half a minute.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may give this a try.
The code takes 17 seconds at my end to complete the task.
Please click the button "Click Here" to test the code.

Sub GetMastheadAndColourCode()
Dim sws As Worksheet, dws As Worksheet
Dim slr As Long, dlr As Long, lc As Long, i As Long, j As Long, k As Long
Dim Arr(), x, y
Dim Found As Boolean
Dim sTime As Date
Application.ScreenUpdating = False

sTime = Now
Set sws = Sheets("Masthead&colourcode")
Set dws = Sheets("LocalZone")

slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
dlr = dws.Cells(Rows.Count, 1).End(xlUp).Row
lc = dws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If lc > 3 Then dws.Range(dws.Cells(2, 4), dws.Cells(dlr, lc)).ClearContents

sws.Range("A2:A" & slr).Formula = "=B2&C2"
sws.Range("A2:A" & slr).Value = sws.Range("A2:A" & slr).Value

x = dws.Range("A1").CurrentRegion.Value
y = sws.Range("A1").CurrentRegion.Value

ReDim Arr(1 To dlr, 1 To slr * 2)

For i = 2 To UBound(x, 1)
    k = 0
    For j = 2 To UBound(y, 1)
        If y(j, 1) = x(i, 2) & x(i, 3) Then
            Found = True
            k = k + 1
            Arr(i, k) = y(j, 4)
            k = k + 1
            Arr(i, k) = y(j, 5)
        End If
    Next j
Next i
dws.Range("D2").Resize(dlr, slr * 2).Value = Arr

Application.ScreenUpdating = True
MsgBox "Task completed in " & Format(Now - sTime, "hh:mm:ss")
End Sub

Open in new window

It is very good to have many experts.
My code - 374 s
Egil's - 55 s
Subodh is a champion with 23 s (my computer seems not to be so fast)

I hope it is one time task, so did not spend many time to optimization
gregfthompsonAuthor Commented:
Thank you all for you help on this.
I tried them all.
als315 - your version appeared to omit the first and last in any group
Subodh - your version also appeared to omit the first and last in any group.
Ejgil - your version took the longest but it appears to copy against all matching postcodes/suburbs.
gregfthompsonAuthor Commented:
Thanks very much for your help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.