View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
merjet merjet is offline
external usenet poster
 
Posts: 812
Default reorder information

The following puts your desired data below the existing data. Adapt if
you want it elsewhere.

Hth,
Merjet

Sub Macro1()
Dim c1 As Range
Dim c2 As Range
Dim iRow1 As Long
Dim iRow2 As Long
Dim iRow3 As Long

iRow1 = Range("A1").End(xlDown).Row
iRow2 = iRow1 + 2
Range("A1:A" & iRow1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A" & iRow2), Unique:=True
Range("C1:E1").Copy Range("C" & iRow2)
iRow3 = Range("A65536").End(xlUp).Row
For Each c2 In Range("A" & iRow2 + 1 & ":A" & iRow3)
For Each c1 In Range("A2:A" & iRow1)
If c1 = c2 Then
For iCol = 3 To 5
If c1.Offset(0, iCol - 1) 0 Then c2.Offset(0, iCol -
1) _
= c2.Offset(0, iCol - 1) & c1.Offset(0, 1) & ",
"
Next iCol
End If
Next c1
Next c2
For Each c2 In Range("C" & iRow2 + 1 & ":E" & iRow3)
c2 = Left(c2, Len(c2) - 2) 'clean up -- remove last ", "
Next c2
End Sub