Removing duplicate rows and combining unique data

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

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

--
Regards,
Tom Ogilvy

<[email protected]> wrote in message
news:[email protected]...
> 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
>

Thanks. It works great!

Regards,
Chris