Ranking sales

Try this:-

Sub MG18Jan32
Dim Rng         As Range
Dim Dn          As Range
Dim n           As Long
Dim Dic         As Object
Set Rng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

For Each Dn In Rng
    If Not Dic.Exists(Dn.Value) Then
        Dic.Add Dn.Value, Dn.Offset(, -1)
    Else
        Dic.Item(Dn.Value) = Dic.Item(Dn.Value) & "," & Dn.Offset(, -1)
End If
Next

For n = 1 To 5
    Cells(2, 5 + n) = Dic.Item(Application.Large(Dic.keys, n))
Next n
End Sub

Regards Mick

You're welcome
Regrds Mick