Finding Matching Values Within Arrays in VBA

Question

Pretty basic question here but my VBA skills are pretty rusty. I have two worksheets where a machine just dumps data into them. Each sheet is just one column and SheetA has ~250 rows and SheetB has ~1300 rows. So what I need to do is compare the first value in sheetA to every value in sheetB, if a match is found I need to copy it to another sheet (SheetC) and then move to the next value in SheetA and repeat this till every value in SheetA has been compared to every value in SheetB. I think the best way to do this is with arrays but I cannot for the life of me remember how to do the actual comparison. Below is the code calling up the sheets and arrays I think....any help is appreciated!

Dim SheetA As Variant
Dim SheetB As Variant
Dim RangeToCheckA As String
Dim RangeToCheckB As String

'Get the worksheets from the workbooks
Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
Set SheetA = wbkA.Worksheets("OSM37")

Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
Set SheetB = wbkB.Worksheets("Master VIN")

'This is the range in SheetA
RangeToCheckA = "B2:B239"
'This is the range in SheetB
RangeToCheckB = "B4:B1339"

SheetA = SheetA.Range(RangeToCheckA)
SheetB = SheetB.Range(RangeToCheckB)

SheetA = SheetA.Range(RangeToCheckA) - is the second instance actually SheetA or is it the actual sheet codename? Same for the next line? — BigBen
– BigBen, Commented Oct 3, 2019 at 20:15
You're re-using SheetA as both the Worksheet object and as the memory-based array. You should create a second Variant as the array variable. — PeterT
– PeterT, Commented Oct 3, 2019 at 20:17
The best way is to use arrays and a Dictionary. How to Compare 2 Lists using Excel VBA(4/4) — TinMan
– TinMan, Commented Oct 3, 2019 at 20:19

ARickman · Accepted Answer · 2019-10-03 20:40:27Z

Without changing much of your code and adding a call to a custom function, you could do the following:

Private Sub CompareWorkBooks()

    Dim wbkA As Workbook, wbkB As Workbook
    Dim SheetA As Worksheet, SheetB As Worksheet, SheetC As Worksheet
    Dim RangeToCheckA As String
    Dim RangeToCheckB As String
    Dim arrySheetA() As Variant, arrySheetB() As Variant, _
        arryOut() As Variant

    'Get the worksheets from the workbooks
    Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
    Set SheetA = wbkA.Worksheets("OSM37")

    Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
    Set SheetB = wbkB.Worksheets("Master VIN")

    'This is the range in SheetA
    RangeToCheckA = "B2:B239"
    'This is the range in SheetB
    RangeToCheckB = "B4:B1339"

    'Value 2 is faster as it doesn't copy formatting
    arrySheetA() = SheetA.Range(RangeToCheckA).Value2
    arrySheetB() = SheetB.Range(RangeToCheckB).Value2

    Set SheetC = wbkB.Worksheets("Sheet C")

    arryOut() = FastLookUp(arrySheetA, arrySheetB, 1, 1, 1)

    SheetC.Range("A1").Resize(UBound(arryOut, 1), _
                                  UBound(arryOut, 2)).Value = arryOut

End Sub

FastLookUp Function:

Private Function FastLookUp(ByRef arryLookUpVals As Variant, ByRef arryLookUpTable As Variant, _
                           ByVal lngLookUpValCol As Long, ByVal lngSearchCol As Long, _
                           ByVal lngReturnCol As Long, _
                           Optional ByVal boolBinaryCompare As Boolean = True) As Variant

  Dim i As Long
  Dim dictLooUpTblData As Object
  Dim varKey As Variant
  Dim arryOut() As Variant

        Set dictLooUpTblData = CreateObject("Scripting.Dictionary")
        If boolBinaryCompare Then
            dictLooUpTblData.CompareMode = vbBinaryCompare
        Else
            dictLooUpTblData.CompareMode = vbTextCompare
        End If

        'add lookup table's lookup column to
        'dictionary
        For i = LBound(arryLookUpTable, 1) To UBound(arryLookUpTable, 1)

            varKey = Trim(arryLookUpTable(i, lngSearchCol))

            If Not dictLooUpTblData.Exists(varKey) Then
                'this is called a silent add with is faster
                'than the standard dictionary.Add Key,Item
                'method
                dictLooUpTblData(varKey) = arryLookUpTable(i, lngReturnCol)
            End If

            varKey = Empty
        Next i

        i = 0: varKey = Empty

        ReDim arryOut(1 To UBound(arryLookUpVals, 1), 1 To 1)

        For i = LBound(arryLookUpVals, 1) To UBound(arryLookUpVals, 1)
            varKey = Trim(arryLookUpVals(i, lngLookUpValCol))

            'if the lookup value exists in the dictionary
            'at this index of the array, then return
            'its correspoding item
            If dictLooUpTblData.Exists(varKey) Then
                arryOut(i, 1) = dictLooUpTblData.Item(varKey)
            End If

            varKey = Empty
        Next i

    FastLookUp = arryOut

End Function

FastLookup functions exactly like a VLOOKUP, but is a bit more flexible, because the the lookup column does not have to be the first one in the range you are looking up, as you are allowed to specify which column by providing a value for lngLookUpValCol parameter.

Vityata · Accepted Answer · 2019-10-03 20:23:06Z

Concerning that you have 3 worksheets in 1 workbook - Worksheets(1) and Worksheets(2) are the one, in which the values in Range("A1:A7") and Range("A1:A3") are compared:

Sub TestMe()

    Dim arrA As Variant
    Dim arrB As Variant

    With Application
        arrA = .Transpose(Worksheets(1).Range("A1:A7"))
        arrB = .Transpose(Worksheets(2).Range("A1:A3"))
    End With

    Dim a As Variant
    Dim b As Variant

    For Each a In arrA
        For Each b In arrB
            If a = b Then
                Worksheets(3).Cells(1 + LastRow(Worksheets(3).Name), 1) = b
            End If
        Next
    Next

End Sub

Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
    Dim ws As Worksheet
    Set ws = Worksheets(wsName)
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function

If you are planning to use the code above, it is a good idea to make sure that the values in Worksheets(1) are all unique, otherwise the code would repeat them N times. Or add a dictionary, to exclude repeated values.

Collectives™ on Stack Overflow

Finding Matching Values Within Arrays in VBA

2 Answers 2

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related