I need to compare data in column A (which contains Names) starting with cell
A2 if a nother cell in column A has the same name then copy cell G in that
row to H2 then repeat the search again and if another match to A2 is found
copy cell G in that row to I2
If no match is found do nothing
I would like to incorporate this into a macro and run it from another sheet
in the workbook

hi kelly,

fill an array with the values in column A
then loop through the cells in column A again, but this time checking
the number of occurances of the cells value in the array - if it occurs
twice then use cells(i,7) to copy the value over to H2,I2 etc

does this help, or do you need a complete answer?
Jason



Kelly******** wrote:

I need to compare data in column A (which contains Names) starting with cell
A2 if a nother cell in column A has the same name then copy cell G in that
row to H2 then repeat the search again and if another match to A2 is found
copy cell G in that row to I2
If no match is found do nothing
I would like to incorporate this into a macro and run it from another sheet
in the workbook

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

If speed's an issue then this should be faster

Public Sub kelly_Faster()
Dim I As Long
Dim J As Long
Dim K As Long
Dim iLastRow As Long
Dim strCalcMode As String
With Application
strCalcMode = .Calculation
..Calculation = xlCalculationManual
..ScreenUpdating = False
End With
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
Calculate
Application.Calculation = strCalcMode
End Sub

Ken Johnson

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

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

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

Hi Kelly,

You're welcome. Thanks for the feedback.

Ken Johnson