I
italia
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 !!!
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 !!!