Can you add a step in this to delete the rows that the duplicated name is in
after it copies cell G

"Ken Johnson" wrote:

Hi Kelly,

Try this on a copy of your worksheet...


Public Sub kelly()
Dim I As Long
Dim J As Long
Dim K As Long
Dim iLastRow As Long
Dim vaNames As Variant
iLastRow = Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
vaNames = Range(Cells(2, 1), Cells(iLastRow, 1)).Value
For I = 2 To iLastRow - 1
K = 0
For J = I + 1 To iLastRow
If Cells(J, 1) = Cells(I, 1) And vaNames(J - 1, 1) < "" Then
vaNames(J - 1, 1) = ""
K = K + 1
Cells(I, 7 + K).Value = Cells(J, 7).Value
End If
Next J
Next I
End Sub


Ken Johnson