Comparing a value between two arrays and passing back - arrays

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