Removing duplicate rows and combining unique data

[mr_man_345]

Hi,

I'm pretty new to Excel VBA programming. I'm trying to make a
subroutine that will iterate through the rows removing all duplicate
rows (using a column A for the unique cell values) and taking and
concatenating all the String values from a different column (F) in rows
with the same key value into one single cell - in the row not deleted
after the duplicate removal.

I'm using CPearson's code for removing duplicates with my own (messy)
additions to try and combine the cell values but it doesn't work
properly. The concatenation part seems to work, but it puts the
concatenated string into the wrong cell (usually beneath). Any
suggestions would be much appreciated.

Code:

Sub DelDuplicates()

Dim rowNumber As Long
Dim toCompany As String
Dim firstTime As Boolean
Dim currentRow As Integer

firstTime = True
currentRow = Selection(Selection.Cells.Count).Row

ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1

If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value
Then
toCompany = toCompany & ", " & Range("F" &
currentRow).Value
Cells(RowNdx, ColNum).EntireRow.Delete
Else
If firstTime = True Then
rowNumber = currentRow
toCompany = Range("F" & currentRow).Value
firstTime = False
Else
rowNumber = currentRow
Range("F" & rowNumber + 1).Value = toCompany
toCompany = Range("F" & currentRow).Value
End If
End If
currentRow = currentRow - 1

Next RowNdx
End Sub

 

[Tom Ogilvy]

Sub DelDuplicates()

Dim rowNumber As Long
Dim toCompany As String
Dim firstTime As Boolean
Dim currentRow As Integer

firstTime = True
currentRow = Selection(Selection.Cells.Count).Row

ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = _
Cells(RowNdx - 1, ColNum).Value Then
toCompany = toCompany & ", " & Range("F" & RowNdx).Value
Cells(RowNdx, ColNum).EntireRow.Delete
Else
If Len(toCompany) > 0 Then
Cells(RowNdx, "F") = Right(toCompany, _
Len(toCompany) - 1) & ", " & Cells(RowNdx, "F")
toCompany = ""
End If
End If
Next RowNdx
End Sub

 

[mr_man_345]

Thanks. It works great!

Regards,
Chris