VBA Matching 2 sets of data

Question

I have this problem right here. I want to match and highlight these two data from table 1 and table 2. The criteria are the contract code must match and so should the sum lots quantity for that contract code in table 2.

For example in table 1 ZBZ8 375 should match and highlight with the three data entries on table 2 50 ZBZ8 125 ZBZ8 200 ZBZ8.

Table 1    
CONTRACT    LOTS
    ZBZ8        375 
    ZBU8        339 
    ZBM8       -250 
    ZBH8        -75 
Table 2
    Qty    Contract
    40      TYZ7
    200     TYZ7C
    -400    TYZ7C
    100     EDZ7
    100     EDZ7
    100     EDZ7
    100     EDH8
    -100    EDZ8
    -100    EDZ8
    -100    EDH9
    -25     ZBH8
    -50     ZBH8
    -250    ZBM8
    114     ZBU8
    200     ZBU8
    25      ZBU8
    50      ZBZ8
    125     ZBZ8
    200     ZBZ8
    25      XMZ7
    -115    YMZ7
    -200    YMZ7

I am very new to VBA, please be patient with me. As Thomas below have mentioned, and it appears Dictionary is the way to go about this?

I have tried the code from the answers below, but it hasn't seemed to work.

Answer 1

Here is an example using a dictionary as suggested in comments.

I have included a couple of loops to highlight both the source rows, and the total rows, where there is not a match, by code, of the individual rows to the sum.

This is based on the your data being set up as per images as follows:

Totals to verify:

Rows to sum:

Note that in this case only TYZ7C was highlighted. It actually only exists in one sheet and not in the other (there was no sum to check against). The totals matched for the others. You might consider highlighting missing codes with a different colour.

The red font of negative numbers is due to the type of formatting already applied and bears no relation to what the code does.

Option Explicit
'Tools > References > Add reference to Microsoft Scripting Runtime

Public Sub CheckTotal()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Futures - DB")       ' change as appropriate e.g. "Futures - DB"
    Set ws1 = wb.Worksheets("Futures - FNZC")

    Dim totalsDict As Scripting.Dictionary       'set reference to microsoft scripting runtime

    Set totalsDict = New Scripting.Dictionary

    Dim valuesArr()
    Dim valuesSource As Range

    Dim lastRowInM As Long

    lastRowInM = ws.Cells(ws.Rows.Count, "M").End(xlUp).Row

    Set valuesSource = ws.Range("M3:N" & lastRowInM) 'range containing values to sum

    valuesSource.Cells.Interior.PatternColorIndex = xlAutomatic

    valuesArr = valuesSource.Value

    AddToDict valuesArr, totalsDict

    ' PrintDict totalsDict

    Dim currCell As Range
    Dim loopRange As Range

    Set loopRange = ws1.Range("C9:D37")          'range containing codes whose sums are to be checked

    loopRange.Cells.Interior.PatternColorIndex = xlAutomatic

    Dim colourCodesArr()
    ReDim colourCodesArr(0 To 1000)              'change this number to a number greater than the expected number of totals to be checked.

    Dim counter As Long
    counter = 0

    For Each currCell In loopRange.Columns(1).Rows

        If Not IsEmpty(currCell) And currCell <> "CONTRACT" Then 'ignore cells in range that don't qualify for consideration

            If currCell.Offset(, 1) = totalsDict(currCell.Value2) Then

                colourCodesArr(counter) = currCell 'store codes whose totals match summing of rows match in array

                counter = counter + 1

            Else

                currCell.Offset(, 1).Interior.ColorIndex = 6 'colour yellow

            End If

        End If

    Next currCell

    ReDim Preserve colourCodesArr(0 To counter - 1)

    For Each currCell In valuesSource.Columns(2).Rows 'Loop the codes in the source range checking if a no match was registered

        If UBound(Filter(colourCodesArr, currCell.Value2)) = -1 Then 'if code not found in array highlight in yellow

            currCell.Offset(, -1).Interior.ColorIndex = 6

        End If

    Next currCell

End Sub

Private Sub AddToDict(ByVal valuesArr As Variant, ByRef totalsDict As Dictionary)

    Dim code As Long

    For code = LBound(valuesArr, 1) To UBound(valuesArr, 1)

        If totalsDict.Exists(valuesArr(code, 2)) Then 'if code exists add new value to existing value otherwise add code and value to the dictionary e.g. TYZ7C ,200


            totalsDict(valuesArr(code, 2)) = totalsDict(valuesArr(code, 2)) + valuesArr(code, 1)

        Else

            totalsDict.Add valuesArr(code, 2), valuesArr(code, 1)

        End If

    Next code

End Sub

Private Sub PrintDict(ByVal totalsDict As Dictionary)

    Dim key As Variant

    For Each key In totalsDict.Keys
        Debug.Print "Key: " & key & " Value: " & totalsDict(key)
    Next
End Sub

Answer 2

Your code using an array actually looks like a decent start.

Here's how I would solve it:

Dim x AS Long, y AS Long
For x = DATA2_STARTING_ROW to 0 ' infinite loop (through data set 2)
    Dim code AS String
    code = Cells(x, DATA2_CODE_COLUMN)
    If code = "" Then Exit For ' no more data

    Dim total AS Integer
    total = 0
    For y = DATA1_STARTING_ROW to 0 ' (through data set 1)
        If Cells(y, DATA1_CODE_COLUMN) = "" Then Exit For
        If Cells(y, DATA1_CODE_COLUMN) = code Then ' found a match
            total = total + Cells(y, DATA1_QUANTITY_COLUMN)
        End If
    Next
    If total = Cells(x, DATA2_QUANTITY_COLUMN) Then ' the totals match
        Cells(x, DATA2_QUANTITY_COLUMN).Interior.Color = RGB(50, 100, 50)
        Cells(x, DATA2_CODE_COLUMN).Interior.Color = RGB(50, 100, 50)
    End If
Next

Just replace the DATA2_QUANTITY_COLUMN, ... variables with your actual values for where your data sets start.