Compare 2 1-D dynamic array - vba

Question

I had 2 tables. The 1st table contains the department name and number of people, the other contains department name and some other information. I'm trying to copy the number of people from the 1st table to the 2nd table based on the department name.
However, the size of the table are not equal as for the 2nd table, the department name can appear more than once or even not at all.
Tables are from different worksheets.
Example of Table 1
Example of Table 2
I had successfully get the data from the column using dynamic array and pass between subs, but unable to compare when copy the value when match.
My codes structure
Sub getTable1()
Dim dept, getNum As Variant
Dim i,x As Long
x = 0
ReDim dept(1 To 1)
ReDim getNum(1 To 1)
With ThisWorkbook.Sheets("Table1")
For i= 1 To .Cells(Rows.Count, "A").End(xlUp).Row
x = x + 1
ReDim Preserve dept(1 To x)
ReDim Preserve getNum(1 To x)
dept(x) = .Cells(i, "A").Value
getNum(x) = .Cells(i, "B").Value
Next x
End With
For i = 1 to x
Call passValue(dept(i), getNum(i))
Next
End Sub
Sub passValue(ByVal dept, getNum As Variant)
Dim target As Variant
ReDim target(1 To 1)
Dim i, cnt, rowCnt As Long
cnt = 0
With ThisWorkbook.Sheets("Table2")
For i = 2 To .Cells(Rows.Count, "D").End(xlUp).Row
cnt = cnt + 1
ReDim Preserve target(1 To cnt)
target(cnt) = .Cells(i, "D").Value
Next i
End With
For i = 1 To cnt
If target(i) = dept Then ' If match print result
With ThisWorkbook.Sheets("Table2")
For rowCnt = 2 To .Cells(Rows.Count, "D").End(xlUp).Row
.Cells(rowCnt, "E").Value = getNum ' Only print the last result
Next
End With
End If
Next
End Sub

Answer 1

Here is an example of what I was describing, you probably want some error handling in case a dept appears in sheet Table2 that is not in Table1:
Public Sub getTable1()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Table1")
Set ws2 = wb.Worksheets("Table2")
Dim lastRowT1 As Long
lastRowT1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A of first sheet
Dim lastRowT2 As Long
lastRowT2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A of second sheet
Dim table1Arr()
table1Arr = ws1.Range("A2:B" & lastRowT1).Value '1 to 4, 1 to 2 'read the range from A2:B to last used row in A e.g. A2:B6 into array creating a 2D array that starts at index 1. The table is now held in the array.
Dim table2Arr()
table2Arr = ws2.Range("A2:B" & lastRowT2).Value '1 to 3, 1 to 2 'read used range containing table 2 into an array.
Dim table1Dict As New Scripting.Dictionary 'required reference to MS Scripting Runtime
Dim i As Long
For i = LBound(table1Arr, 1) To UBound(table1Arr, 1) 'loop the first dimension of array 1 i.e. the depts.
If table1Dict.Exists(table1Arr(i, 1)) Then
table1Dict(table1Arr(i, 1)) = table1Dict(table1Arr(i, 1)) + table1Arr(i, 2) 'if dept exists as a key in the dict then add the number of people from array 1 (i.e. from table 1) to the existing value. This handles potentially repeating depts in table1.
Else
table1Dict.Add table1Arr(i, 1), table1Arr(i, 2) 'if dept not already in dict, add the dept as a key to the dict and the number of people as the value.
End If
Next i
For i = LBound(table2Arr, 1) To UBound(table2Arr, 1) 'next loop your table 2 array depts
table2Arr(i, 2) = table1Dict(table2Arr(i, 1)) 'as department names are spelt the same across both tables you can use the table2 dept names as the key to retrieve the dictionary values for that dept in the dictionary i.e. from table1. Then simply assign that to the Others column i.e. table2Arr(i, 2)
Next i
End Sub
See Chip Pearson's article on working with arrays. From that article you can see how to write back out to Table2 sheet the second array:
Writing A Two Dimensional VBA Array To The Worksheet
If you have a 2 dimensional array, you need to use Resize to resize
the destination range to the proper size. The first dimension is the
number of rows and the second dimension is the number of columns. The
code below illustrates writing an array (..table2Arr..) out to the worksheet
starting at cell (..A2..).
Dim Destination As Range
Set Destination = ws2.Range("A2")
Destination.Resize(UBound(table2Arr, 1), UBound(table2Arr, 2)).Value = table2Arr