Excel Macro to copy and transpose values

[sgkurian]

Hello

I am trying to develop a macro in Excel which copies and transposes the data in one column.
The number of rows varies for each set that I am trying to transpose which is where I am getting stuck in the development of the macro
Below is a sample of the data and the desired output I am trying to attain


Original Data (Sample)

Postcode Suburb
2000 SYDNEY
2000 SYDNEY SOUTH
2000 THE ROCKS
2010 DARLINGHURST
2010 SURRY HILLS
2011 ELIZABETH BAY
2011 HMAS KUTTABUL
2011 POTTS POINT
2011 RUSHCUTTERS BAY
2011 WOOLLOOMOOLOO
2026 BONDI
2026 BONDI BEACH
2026 NORTH BONDI
2026 TAMARAMA
2036 CHIFLEY
2036 EASTGARDENS
2036 HILLSDALE
2036 LA PEROUSE
2036 LITTLE BAY
2036 MALABAR
2036 MATRAVILLE
2036 PHILLIP BAY
2036 PORT BOTANY

Desired Output (all the suburbs should be on the same row as the postcode)

Postcode Suburb
2000 SYDNEY, SYDNEY SOUTH, THE ROCKS
2010 DARLINGHURST, SURRY HILLS
2011 ELIZABETH BAY, HMAS KUTTABUL, POTTS POINT, RUSHCUTTERS BAY, WOOLLOOMOOLOO
2026 BONDI, BONDI BEACH, NORTH BONDI, TAMARAMA
2036 CHIFLEY, EASTGARDENS, HILLSDALE, LA PEROUSE, LITTLE BAY, MALABAR, MATRAVILLE, PHILLIP BAY, PORT BOTANY

Any help will be greatly appreciated



Regards
Steve

 

[Gruuuu]

Fun problem!

There's lots of ways to do it. Here's my stab.

precursor: Must have column headers(like your data shows, with postcode and suburb)! If not, advancedfilter gets confused and assumes the first row is a header.

Sub trythis()

Dim member, target As Range

[green]'This builds your postcode list into a unique list.[/green]
Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1"), Unique:=True

For Each member In Range(Range("A1"), Range("A1").End(xlDown))

    [green]'Find the postcode in the unique list[/green]
    Set target = ActiveSheet.Range("E1:E6").Find(member)

    [green]'build out the list, one burb at a time.[/green]
    If IsEmpty(target.Offset(0, 1).Value) Then
        target.Offset(0, 1).Value = member.Offset(0, 1).Value
    Else
        target.End(xlToRight).Offset(0, 1).Value = member.Offset(0, 1).Value
    End If
Next member
End Sub