Comparing a value between two arrays and passing back

Question

I have two tables that have an identical column structure where the information passed from a different department is put into the first template.

I want to look at the SKU from Table 1 and pass back everything that matches on that row in Table 2 - whilst ignoring any SKU code that is not on Table 1.

Graphical illustration of problem

The code is part of a larger sub (variables are declared prior etc.) which uses a scripting dictionary and then goes through a For loop - but this is not efficient:

    Set dlCD1 = CreateObject("Scripting.Dictionary")
    Row = 1
    On Error GoTo Error
    For Each cCD1 In Sheets("TABLE 2 SHEET").Range("c1:c" & MaxLineMPS)
        tmpCD1 = Trim(cCD1.Value)
        If Len(tmpCD1) < 10 Then tmpCD1 = "0" & tmpCD1
        If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1
    Next cCD1
    
    For Each kCD1 In dlCD1.keys
    
        With Sheets("TABLE 1 SHEET").Range("a2:x" & MaxLineMatrice)
            .AutoFilter Field:=3, Criteria1:=kCD1
        End With
    
        If Sheets("TABLE 1 SHEET").Range("A2:A" & MaxLineMatrice).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With Sheets("TABLE 1 SHEET").Range("d$3:x" & "$" & MaxLineMatrice).SpecialCells(xlCellTypeVisible)
                .Value = Sheets("TABLE 2 SHEET").Range("$d" & "$" & Row & ":$x" & "$" & Row).Value
            End With
        Else: End If
    
        Row = Row + 1
        Debug.Print kCD1, dlCD1(kCD1)
    Next kCD1
    
    Worksheets("TABLE 1 SHEET").AutoFilterMode = False
    dlCD1.RemoveAll

I have thousands of SKU codes and this takes time to loop through. I am told that by doing this outside of the sheet I can do the job faster.

Here's my whole code:

Sub Month_RiempiFuturo()
    Dim MinLineMatrice As Integer, MaxLineMatrice As Integer, MinLineMPS As Integer, MaxLineMPS As Integer, row As Integer
    Dim dlCD1 As Object, cCD1 As Range, kCD1, tmpCD1 As String, dlCD2 As Object, cCD2 As Range, kCD2, tmpCD2 As String
    Dim StartTime As Double, SecondsElapsed As Double
    Dim PT1 As PivotTable
    Application.EnableEvents = False
    Application.DisplayStatusBar = False
    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationManual
    Worksheets("TABLE SHEET 1").AutoFilterMode = False
    Worksheets("TABLE SHEET 2").AutoFilterMode = False
    StartTime = Timer
    MinLineMatrice = 3
    MaxLineMatrice = Sheets("TABLE SHEET 1").Range("A" & Rows.Count).End(xlUp).Row
    MinLineMPS = 1
    MaxLineMPS = Sheets("TABLE SHEET 2").Range("C" & Rows.Count).End(xlUp).Row
    LastLineFINITY = Sheets("FINITY CAPACITY PLANNED").Range("A" & Rows.Count).End(xlUp).Row
    Set PT1 = Worksheets("shift").PivotTables("Tabella_pivot1")
    Worksheets("TABLE SHEET 1").Range("d3:x" & MaxLineMatrice).ClearContents
    Set dlCD1 = CreateObject("Scripting.Dictionary")
    Row = 1
    On Error GoTo Error
    For Each cCD1 In Sheets("TABLE SHEET 2").Range("c1:c" & MaxLineMPS)
        tmpCD1 = Trim(cCD1.Value)
        If Len(tmpCD1) < 10 Then tmpCD1 = "0" & tmpCD1
        If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1
    Next cCD1
    For Each kCD1 In dlCD1.keys
        With Worksheets("TABLE SHEET 1").Range("a2:x" & MaxLineMatrice)
            .AutoFilter Field:=3, Criteria1:=kCD1
        End With
        If Sheets("TABLE SHEET 1").Range("A2:A" & MaxLineMatrice).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With Sheets("TABLE SHEET 1").Range("d$3:x" & "$" & MaxLineMatrice).SpecialCells(xlCellTypeVisible)
                .Value = Sheets("TABLE SHEET 2").Range("$d" & "$" & Row & ":$x" & "$" & Row).Value
            End With
        Else: End If
        Row = Row + 1
        Debug.Print kCD1, dlCD1(kCD1)
    Next kCD1
    Worksheets("TABLE SHEET 1").AutoFilterMode = False
    dlCD1.RemoveAll
    Set dlCD1 = CreateObject("Scripting.Dictionary")
    For Each cCD1 In Sheets("Finity capacity planned").Range("a2:a" & LastLineFINITY)
        tmpCD1 = Trim(cCD1.Value)
        If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1
    Next cCD1
    Set dlCD2 = CreateObject("Scripting.Dictionary")
    For Each cCD2 In Sheets("Finity capacity planned").Range("b2:b" & LastLineFINITY)
        tmpCD2 = Trim(cCD2.Value)
        If Len(tmpCD2) > 0 Then dlCD2(tmpCD2) = dlCD2(tmpCD2) + 1
    Next cCD2
    For Each kCD1 In dlCD1.keys
        With Sheets("Finity capacity planned").Range("A1:Ak" & LastLineFINITY)
            .AutoFilter Field:=1, Criteria1:=kCD1
            .AutoFilter Field:=2, Criteria1:=Array( _
              dlCD2.keys()(0), dlCD2.keys()(2), dlCD2.keys()(4), dlCD2.keys()(6), dlCD2.keys()(8), dlCD2.keys()(10)), Operator:=xlFilterValues
        End With
        With Sheets("Finity capacity planned").Range("A2:Ak" & LastLineFINITY).SpecialCells(xlCellTypeVisible)
            .Interior.ColorIndex = 15
        End With
        With Sheets("Finity capacity planned").Range("A1:Ak" & LastLineFINITY)
            .AutoFilter Field:=1, Criteria1:=kCD1
            .AutoFilter Field:=2, Criteria1:=Array( _
              dlCD2.keys()(1), dlCD2.keys()(3), dlCD2.keys()(5), dlCD2.keys()(7), dlCD2.keys()(9), dlCD2.keys()(11)), Operator:=xlFilterValues
        End With
        With Sheets("Finity capacity planned").Range("A2:Ak" & LastLineFINITY).SpecialCells(xlCellTypeVisible)
            .Interior.ColorIndex = 19
        End With
        Debug.Print kCD1, dlCD1(kCD1)
    Next kCD1
    Worksheets("Finity capacity planned").AutoFilterMode = False
    dlCD1.RemoveAll
    dlCD2.RemoveAll
    With PT1
        .RefreshTable
    End With
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
    ActiveSheet.DisplayPageBreaks = True
    Application.Calculation = xlCalculationAutomatic
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "This code including the time for user prompts to be acknowledged took " & SecondsElapsed & " Seconds", vbInformation, "McManus automation speed testing"
    Exit Sub
Error:
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
    ActiveSheet.DisplayPageBreaks = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Something went wrong"
End Sub

Answer 1

You can use Find function to find the row number you are looking for. Then using this row number, you can have the data from that row.

I didn't dig into your code too much, because it is a bit messy. So considering that:

• Blank Lookup sheet name is "TABLE 1 SHEET",
• Master Lookup sheet name is "TABLE 2 SHEET",
• Results sheet name is "TABLE 3 SHEET",

then you can try the following:

Sub findmydata()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim i As Long, j As Long, foundrow As Long, lastrow1 As Long, lastrow2 As Long

Set ws1 = Sheets("TABLE 1 SHEET")
Set ws2 = Sheets("TABLE 2 SHEET")
Set ws3 = Sheets("TABLE 3 SHEET")

lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastrow1
    On Error Resume Next
    foundrow = ws2.Range("A1:A" & lastrow2).Find(ws1.Cells(i, 1).Value).Row
    If Err.Number = 91 Then
        ws3.Cells(i, 1) = ws1.Cells(i, 1)
    Else
        For j = 1 To 4
            ws3.Cells(i, j) = ws2.Cells(foundrow, j)
        Next j
    End If
Next
End Sub