Question: I am trying to find duplicate values in one column and combine the values of a second column into one row. I also want to sum the values in a third column.

For example:

```
A    B    C    D
h    4    w    3
h    4    u    5
h    4    g    7
h    4    f    4
k    9    t    6
k    9    o    6
k    9    p    9
k    9    j    1

```

Would become

```
A    B    C        D
k    9    t;o;p;j  22
h    4    w;u;g;f  19

```

The code I have been using for the first part of this is

```
 Sub mergeCategoryValues()
Dim lngRow As Long

With ActiveSheet

lngRow = .Cells(65536, 1).End(xlUp).Row

.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 
Do

    If .Cells(lngRow, 9) = .Cells(lngRow + 1, 9) Then
        .Cells(lngRow, 11) = .Cells(lngRow, 8) & "; " & .Cells(lngRow + 1, 8)
        .Rows(lngRow +1).Delete
    End If

    lngRow = lngRow - 1

Loop Until lngRow < 2

End With

End Sub

```

(please forgive the indentation)

The problem that I am running into is that it will find the first pair of duplicates, but not all. So I get a result that looks like this:

```
A    B    C    D
k    9    t;o  12
k    9    p;j  10   
h    4    w;u  8
h    4    g;f  11

```

Thoughts? 

Thank you in advance.

Answer: 
Here is my solution

```
Sub MyCombine()
Dim i As Integer
ActiveSheet.Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
    .SetRange Range("A:D")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlStroke
    .Apply
End With

i = 2

Do Until Len(Cells(i, 1).Value) = 0
    If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
        Cells(i, 3).Value = Cells(i, 3).Value & ";" & Cells(i + 1, 3).Value
        Cells(i, 4).Value = Cells(i, 4).Value + Cells(i + 1, 4).Value
        Rows(i + 1).Delete
    Else
        i = i + 1
    End If
Loop    
End Sub

```
This will do what you want.

```
Sub Macro()
Dim lngRow As Long
For lngRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If StrComp(Range("B" & lngRow), Range("B" & lngRow - 1), vbTextCompare) = 0 Then
If Range("C" & lngRow) <> "" Then
Range("C" & lngRow - 1) = Range("C" & lngRow - 1) & ";" & Range("C" & lngRow)
Range("D" & lngRow - 1) = Range("D" & lngRow - 1) + Range("D" & lngRow)
End If
Rows(lngRow).Delete
End If
Next
End Sub

```