There's an option under Data|Filter|advanced filter that you can use to extract
unique values/rows in your range.

Debra Dalgleish explains how to use it at:
http://www.contextures.com/xladvfilter01.html#FilterUR

You can use that in code, too.

Option Explicit
Sub testme()

Dim InputRng As Range
Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("sheet1")

With wks
Set InputRng = .Range("a1:b" & .Cells(.Rows.Count, "A").End(xlUp).Row)

InputRng.Sort _
key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("b1"), order2:=xlAscending, _
header:=xlYes

InputRng.AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("D1"), Unique:=True

.Range("a1:c1").EntireColumn.Delete

FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
'same value
.Cells(iRow - 1, "B").Value _
= .Cells(iRow - 1, "B").Value _
& ", " & .Cells(iRow, "B").Value
.Rows(iRow).Delete
End If
Next iRow


End With

End Sub

Try this against a copy of your worksheet--it destroys the original data when it
runs.


italia wrote:
>
> I have a spreadsheet with 2 columns and thousands of rows. The first
> column is the id
>
> Example of the data (2 columns)-
>
> 04731 CRM
> 04731 CRM
> 04731 CRM
> 04731 RVB
> 04731 RVB
> 25475 FRB
> 25475 FRB
> 25475 MMX
> 25475 MMX
>
> Result desired (2 columns)-
>
> 04731 CRM; RVB
> 25475 RVB; MMX
>
> Idea is to summarize the data and eliminate the duplicates
>
> I am using the folloeing Code but it does not provide the desired
> result-
>
> Sub Test1()
> Dim lastrow As Long
> Dim i As Long
> lastrow = Cells(Rows.Count, 1).End(xlUp).Row
> i = lastrow
> Do While i > 1
> If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
> If Cells(i, 2).Value = Cells(i - 1, 2).Value Then
> Cells(i, 1).EntireRow.Delete
> Else
> Cells(i - 1, 2).Value = Cells(i - 1, 2).Value & "; " & _
> Cells(i, 2).Value
> Cells(i, 1).EntireRow.Delete
> End If
> End If
> i = i - 1
> Loop
> End Sub
>
> Any help is greatly appreciated.
>
> Thanks !!!

--

Dave Peterson