Getting duplicate names

[John]

I'm going through a list of data that I sort from highest to lowest ratings
depending on what category their in, A, B, C.... That part works fine. I then
attempt to match up names with the ratings by looping through and finding a
match to these ratings. I then concatenat the last name and first name and
place in adjacent cell. Everything works except when it comes across two
ratings that are equal. Two samples were found to be exact in League B. The
first placed the names correctly but not the second, it duplicated the name
instead of searching further into the list. Below is both programming and a
sample output of what I have. I've changed the names to protect the innocent.


Sub Name_to_MVP_Player()
'
' Concatenate First name Last name

Dim myobject As Range
Dim z As Long
Dim i As Long
Dim y As Long
Dim x As Long

For y = 15 To 21 Step 2
x = 3
Do While Cells(x, y) <> ""
i = 3
z = 2

Do While Cells(i, 13) <> ""
If Cells(x, y) = Cells(i, 13) Then
Cells(x, y - 1) = Cells(i, 4) & " " & Cells(i, 3)
Exit Do
End If
i = i + 1
Loop
End If
x = x + 1
Loop
Next
End Sub

Col N O P Q

League A League B
Jon B 2.25000 Tom W 2.75625
Mike B 2.14881 John W 2.59740
Frank B 1.78182 Jason K 2.59740
Jim W 1.75781 Ed M 2.53125
Ralph N 1.71429 Harry B 2.50694
Dave H 0.81667 Scott S 1.92857
Jason I 0.70000 Tony C 1.50000
Ray D 0.64286 Dennis A 1.40000
Mike S 0.62500 Vicky N 1.26042
Tim W 0.40909 Vicky N 1.26042
Bethann F 0.40000 Dave C 1.06667
Rodney E 0.28571 Connie D 1.01250

I would appreciate some help on this, thanks.

 

[JLGWhiz]

Can you not just sort it all in one fell swoop by making the ratings the
primary sort range in descending order and the names the secondary sort range
in ascending order. Or am I looking at only part of the picture.

 

[John]

I was having problems erroring out when I did this before because the
original information is in other cells which I do not want to change. The
code for sorting is below even though I have not completed the number of
leagues (C & D). If you know how to add the concatenated names to the left
cell assocoated with the rating I would appreciate the help.

Thanks,

Sub MVP_Players()
Dim myobject As Range
For x = 3 To 500

If Cells(x, 2) = "A" Then
Cells(x, 13).Select
ActiveCell.Copy
Cells(x, 15).Select
Application.ActiveCell.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("O3:O132").Select
Selection.Sort Key1:=Range("O3"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O1").Select
End If
If Cells(x, 2) = "B" Then
Cells(x, 13).Select
ActiveCell.Copy
Cells(x, 17).Select
Application.ActiveCell.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Range("Q3:Q132").Select
Selection.Sort Key1:=Range("Q3"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("Q1").Select
Next x
End Sub

 

[John]

After looking at some of the old programming, I believe I finally got what I
was looking for. My formula to carry over and concatenate the names were
wrong. So simple but so far away.

Sub MVP_Players()

Dim myobject As Range
For x = 3 To 132

If Cells(x, 2) = "A" Then
Cells(x, 13).Select
ActiveCell.Copy
Cells(x, 15).Select
Application.ActiveCell.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells(x, 14) = Cells(x, 4) & " " & Cells(x, 3)
End If
If Cells(x, 2) = "B" Then
Cells(x, 13).Select
ActiveCell.Copy
Cells(x, 17).Select
Application.ActiveCell.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells(x, 16) = Cells(x, 4) & " " & Cells(x, 3)
End If
Next x
Range("N3:O132").Select
Selection.Sort Key1:=Range("O3"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("P3:Q132").Select
Selection.Sort Key1:=Range("Q3"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

Even though this is not complete, I can now continue on to help complete
this task for my son.

Thnx "JLGWhiz" for your reply because you got me thinking again.