Cross Reference Numbers Help

With your Data starting in "A1" , Try this for results in column "C".

Sub MG25Sep15
Dim Dn          As Range
Dim Rng         As Range
Dim Dic         As Object
Dim k           As Variant
Dim Str         As String
Dim n           As Long
Dim nn          As Long
    
   Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   For Each Dn In Rng
            If Not Dic.exists(Dn.Value) Then
                Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            End If
         Set Dic(Dn.Value)(Dn.Offset(, 1).Value) = Dn
    Next Dn
   
    For Each k In Dic.keys
        For n = 0 To Dic(k).Count - 1
            For nn = 0 To Dic(k).Count - 1
                If Not Dic(k).keys()(n) = Dic(k).keys()(nn) Then
                    Str = Str & "," & Dic(k).keys()(nn)
                End If
            Next nn
             Dic(k).Item(Dic(k).keys()(n)).Offset(, 2).Value = Mid(Str, 2): Str = ""
       Next n
  Next k
End Sub

Regards Mick

Mick

Thank you so much for the help! It worked perfectly!!

Again, thank you for your help.

You're welcome