Copy Numbers based on compare names in 2 Sheets

**abjac** · 06-06-2013, 01:02 PM

HI I would like to have some help with this problem.
In sheet "Final Match" i need to compare the names in column C
with names in sheet "New Cars input" column B
It need to find the matching payments in column M Sheet "New Cars input"
and display them in new column J Sheet "Final Match".
So i guess its a kind of vlookup. But i need a macro for this.

In Below testsheet you can see how it have to be.

I have also this below code, which i think is a jindon code, which maybe can be changed so it works here.
I have tried but cant make that work

But please have a look.

Sincerely

Abjac

The code which maybe can be changed.

Option Explicit

Sub FIndmatches()
    Dim a, e, s, i As Long, n As Long
    a = Sheets("Findsheet").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For i = 2 To UBound(a, 1)
            Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
            .Item(a(i, 1)).comparemode = 1
        Next
        a = Sheets("Lookupsheet").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .Exists(a(i, 1)) Then .Item(a(i, 1))(a(i, 2)) = Empty
        Next
        ReDim a(1 To UBound(a, 1), 1 To 2)
        For Each e In .Keys
            n = n + 1
            a(n, 1) = e
            a(n, 2) = ""
            If .Item(e).Count > 0 Then
                For Each s In .Item(e).Keys
                    a(n, 2) = s
                    n = n + 1
                Next
                n = n - 1
            End If
        Next
      End With
    With Sheets("Match").UsedRange
        '.CurrentRegion.ClearContents
     .Range("A1:B1") = Array("Names.", "Customer Numbers.")
       With .Offset(.Rows.Count + 1).Resize(n)
       .Value = a
      End With
    End With
End Sub

**nilem** · 06-06-2013, 01:37 PM

Hi Abjac,
try it

Sub FIndmatches()
Dim x, y, i&
x = Sheets("Final Match").Cells(1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
    .comparemode = 1
    For i = 1 To UBound(x)
        .Item(x(i, 4)) = i: x(i, 1) = Empty
    Next i
    y = Sheets("New Cars input").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(x, 1)
        If .Exists(y(i, 3)) Then x(.Item(y(i, 3)), 1) = y(i, 13)
    Next
End With
x(1, 1) = "New Cars Input"
With Sheets("Final Match").Columns(10)
    .ClearContents: .Cells(1).Resize(UBound(x)).Value = x
End With
End Sub

**abjac** · 06-06-2013, 02:01 PM

Hi Nilem. I have checked with the numbers,It works like a dream. Find everything and the test i make on the numbers is just perfect.
So great thanks allot and have a nice evening

Sincerely

Abjac