As alway you all are GREAT seems to work fine.
I wish I could catch on to this stuff better.
Thanks

"Ken Johnson" wrote:

Hi Kelly,

This is the best I could do...

Public Sub kellyWithDelete()
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(J, 1).Value = ""
Cells(I, 7 + K).Value = Cells(J, 7).Value
End If
Next J
Next I
For I = iLastRow To 2 Step -1
If Cells(I, 1).Value = "" Then
Cells(I, 1).EntireRow.Delete
End If
Next I
End Sub


Instead of deleting the row as each duplicate is found, they are
cleared instead, then after the first loop has finished transferring
all the G cell values, a final loop goes back and deletes the rows
based on column A cell being blank. Deleting rows as you go has to be
done from bottom to top, otherwise the deleted rows make it very
difficult for the code to keep track of when it should finish.

Ken Johnson