Match 2D arrays and output values of another array - arrays

Question

I cannot get to work condition for matching 2D arrays. I have tried another approach and this one is closer to the solution, but still does not produce the outcome.
This is what I want to do:
In sheet1 I have different dates that go through columns and size is uncertain. Below these dates are the values:
In sheet 2, I have a smaller subset of dates (that should exist in sheet1):
Through the code, I want to match the dates in sheet1 and sheet2, and only if match is true, I want to write the corresponding values from sheet1 to sheet2.
This is the outcome:
I want to use Arrays for dates in sheet1 and sheet2 and if they match, write the array of values. But the arrays of dates turn to be empty and so condtion for match does not work. I am not getting any error message as well:
Sub test()
Dim arrAmounts() As Variant
Dim arrDates_w2() As Variant
Dim arrDates_w1() As Variant
Dim Lastcol_w2 As Integer
Dim Lastcol_w1 As Integer
Dim LastRow As Integer
Dim i As Integer
Dim w As Integer
Dim d As Integer
Dim f As Integer
Dim g As Integer
Dim w1 As Worksheet
Dim w2 As Worksheet
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
LastRow = 17 'last row on both sheets
f = 1
g = 1
With w2
Lastcol_w2 = .Cells(3, Columns.Count).End(xlToLeft).Column
'array of dates in w2
ReDim arrDates_w2(1, Lastcol_w2)
End With
With w1
Lastcol_w1 = .Cells(3, Columns.Count).End(xlToLeft).Column
'Assign arrays:
ReDim arrAmounts(LastRow, Lastcol_w1)
ReDim arrDates_w1(1, Lastcol_w1)
For i = 1 To LastRow
For d = 1 To UBound(arrDates_w1, 2)
arrAmounts(i, d) = .Cells(3 + i, 2 + d)
Next
Next
'Match the dates in worksheets 1 and 2
For i = 1 To LastRow
For w = 1 To UBound(arrDates_w2, 2)
For d = 1 To UBound(arrDates_w1, 2)
If arrDates_w2(1, w) = arrDates_w1(1, d) Then
w2.Cells(i + 3, 2 + w) = arrAmounts(i, f + 3)
End If
Next
Next
Next
End With
End Sub
I would appreciate suggestions.

Answer 1

Please try this code.
Option Explicit
Sub CopyColumns()
Const CaptionRow As Long = 3 ' on all sheets
Const FirstClm As Long = 3 ' on all sheets
Dim WsIn As Worksheet ' Input sheet
Dim WsOut As Worksheet ' Output sheet
Dim DateRange As Range ' dates on WsIn
Dim Cin As Long ' input column
Dim Rl As Long ' last row in WsIn
Dim Cl As Long ' last used column in WsOut
Dim C As Long ' column counter in WsOut
Dim Arr As Variant ' transfer values
Set WsIn = Worksheets("Sheet1")
Set WsOut = Worksheets("Sheet2")
With WsIn
Set DateRange = .Range(.Cells(CaptionRow, FirstClm), .Cells(CaptionRow, .Columns.Count).End(xlToLeft))
End With
With WsOut
Cl = .Cells(CaptionRow, .Columns.Count).End(xlToLeft).Column
For C = FirstClm To Cl
On Error Resume Next
Cin = Application.Match(.Cells(CaptionRow, C).Value2, DateRange, 0)
If Err = 0 Then
Cin = Cin + DateRange.Column - 1
Rl = WsIn.Cells(WsIn.Rows.Count, Cin).End(xlUp).Row
Arr = WsIn.Range(WsIn.Cells(CaptionRow + 1, Cin), WsIn.Cells(Rl, Cin)).Value
.Cells(CaptionRow + 1, C).Resize(UBound(Arr)).Value = Arr
End If
Next C
End With
End Sub

Answer 2

What do you expect ReDim arrDates_w2(1, Lastcol_w2) to be doing? As it stands, it's only re-sizing the number of items that can be held in the array... You need to assign the Range to it: arrDates_w2 = w2.Range("C3:K3").Value for example. This will create a multi-dimensional array.
Then you can loop the items. Here's some sample code to illustrate the principle
Sub GetArrayInfo()
Dim a As Variant, i As Long, j As Long
Dim w2 As Worksheet
Set w2 = Sheets("Sheet2")
a = ws.Range("C3:K3").Value2
Debug.Print UBound(a, 1), UBound(a, 2)
For j = 1 To UBound(a, 2)
For i = 1 To UBound(a, 1)
Debug.Print a(i, j)
Next
Next
End Sub

Answer 3

Try
Sub test()
Dim Ws As Worksheet, Ws2 As Worksheet
Dim c As Integer, j As Integer, p As Integer
Dim i As Long, r As Long
Dim arr1() As Variant, arr2() As Variant
Dim rngDB As Range, rngHead As Range
Set Ws = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
With Ws
c = .Cells(3, Columns.Count).End(xlToLeft).Column
r = .Range("c" & Rows.Count).End(xlUp).Row
Set rngHead = .Range("c3", .Cells(3, c))
arr1 = .Range("c3", .Cells(r, c))
End With
With Ws2
c = .Cells(3, Columns.Count).End(xlToLeft).Column
Set rngDB = .Range("c3", .Cells(r, c))
arr2 = rngDB
End With
For j = 1 To UBound(arr2, 2)
p = WorksheetFunction.Match(arr2(1, j), rngHead, 0)
For i = 2 To UBound(arr2, 1)
arr2(i, j) = arr1(i, p)
Next i
Next j
rngDB = arr2
End Sub