reorder info
thanks but with this code i get an error saying: block if without end if
"merjet" wrote:
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
|