CODEWITHSUNDEEP
vbaexcel
Bob22
Bob22

Reputation: 109

Need to rank duplicate text values in a column Excel vba

I have some 300 names in a column, I want to rank them and want to include duplicate values eg: if Smith is #3 and #4 on list, they will be put there.

my Current code, which is not working:

Sub karp()
Dim Prescribers As Worksheets
Dim n, r, LR As Long
Dim name1, name2 As String

LR = Cells(Rows.Count, "b").End(xlUp).Row

    For n = 4 To LR         'to loop through the range for a match
        For a = 1 To 273    'number of possible name ranks
            Sheets("Names").Cells(n, 3) = a                       'places rank score
                name1 = Sheets("Names").Cells(n, 3).Value         'checks name
                name2 = Sheets("Names").Cells(n + 1, 3).Value     'checks next name
            If name1 <> name2 Then
        Next a
        Next n
             End If
    Next n

End Sub

Any suggestions on a repair?

Upvotes: 2

Views: 1071

Answers (1)

Vasily
Vasily

Reputation: 5782

if I correctly understood then you can use this:

Sub karp()
    Dim i&, Cl As Range, rn&
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    i = Cells(Rows.Count, "b").End(xlUp).Row
    rn = 1
    For Each Cl In Range("C4:C" & i)
        If Not Dic.exists(Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value)) Then
            Dic.Add Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value), rn
            rn = rn + 1
        End If
    Next Cl
    For Each Cl In Range("C4:C" & i)
        Cl.Offset(, 2).Value = Dic(Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value))
    Next Cl
End Sub

Output

enter image description here

Upvotes: 1

Related Questions