look for exact number in columns according to number of the left part

I have this macro

Sub busca_numeros()
Rem busca numeros iniciando en la celda a1
Dim unicos As New Collection
Set sorteo = Range("a2").CurrentRegion

With sorteo
    For i = 1 To .Columns.Count
        numero = Val(.Cells(1, i))
        On Error Resume Next
            unicos.Add numero, CStr(numero)
        On Error GoTo 0
    Next i

    Set numeros = Range("g:bw")

With numeros
    .Interior.ColorIndex = xlNone
    For i = 1 To 4
        numero = unicos.Item(i)
        cuenta = WorksheetFunction.CountIf(numeros, numero)
        For j = 1 To cuenta
            If j = 1 Then Set xbusca = .Find(numero)
            If j > 1 Then Set xbusca = .FindNext(xbusca)
            Range(xbusca.Address).Interior.ColorIndex = 4
        Next j
    Next i
End With
End With
End Sub

and what it does is find all the matches of a 4-digit number that is located on the left but what I want is to find the exact number in each box and not fill in the others I put an example image:

I appreciate your help