Index match match/vlookup in VBA - vba

Question

I have an Excel document with two different Sheets. Sheet 2 has columns header names and rows header names. Sheet 1 has some of these columns with exact header names and rows header names but it's filled with data.
enter image description here, enter image description here
I want to make a macro that will look through all the column/rows headers in Sheet 1 and find their corresponding match in Sheet2. When the match is found, I need to copy the entry of the Sheet column/row header into the matching header of sheet2. Some entries in Sheet2 will not have matches and will remain blank.
I want it to look like this:
enter image description here
This is my code so far, it is working for the column headers but I don't know how to add for row headers as well. Any help is welcomed :)
Sub CopyData()
Application.ScreenUpdating = False
Dim LastRow As Long, header As Range, foundHeader As Range, lCol As Long, srcWS As Worksheet, desWS As Worksheet
Set srcWS = Sheets("Sheet1")
Set desWS = Sheets("Sheet2")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = desWS.Cells(3, Columns.Count).End(xlToLeft).Column
For Each header In desWS.Range(desWS.Cells(3, 2), desWS.Cells(3, lCol))
Set foundHeader = srcWS.Rows(2).Find(header, LookIn:=xlValues, lookat:=xlWhole)
If Not foundHeader Is Nothing Then
srcWS.Range(srcWS.Cells(3, foundHeader.Column), srcWS.Cells(LastRow, foundHeader.Column)).Copy desWS.Cells(4, header.Column)
End If
Next header
Application.ScreenUpdating = True
End Sub

Answer 1

You can use built-in Range.Consolidate method (https://learn.microsoft.com/en-us/office/vba/api/excel.range.consolidate):
(Edit2)
Option Explicit
Sub ConsolidateThis()
Dim rng1 As Range, rng2 As Range, addr As String
With ThisWorkbook
' determine source and destination ranges
Set rng1 = getTableRange(.Worksheets("Sheet1").Range("A2"))
Set rng2 = getTableRange(.Worksheets("Sheet2").Range("A3"))
' make full address of consolidated range like "'[Consolidate.xlsm]Sheet1'!R3C1:R6C5"
addr = "'[" & .Name & "]" & rng1.Parent.Name & "'!" & rng1.Address(ReferenceStyle:=xlR1C1)
' do consolidation
rng2.Consolidate Sources:=Array(addr), Function:=xlSum, TopRow:=True, LeftColumn:=True
End With
End Sub
' Returns the range that starts with the top left corner cell and is bounded
' on the right and bottom by empty cells
Function getTableRange(LeftTopCornerCell As Range) As Range
Dim ws As Worksheet, rightEdge As Long, downEdge As Long
With LeftTopCornerCell(1)
Set ws = .Parent
rightEdge = ws.Cells(.Row, ws.Columns.Count).End(xlToLeft).Column
downEdge = ws.Cells(ws.Rows.Count, .Column).End(xlUp).Row
End With
Set getTableRange = ws.Range(LeftTopCornerCell(1), ws.Cells(downEdge, rightEdge))
End Function

Answer 2

Your best solution might to set 2 ranges, each taking values from tables in Sheet1 and Sheet2. Let's call them rgSrcTable and rgDestTable. Then you need to loop using For Each through each range and compare top and left headers, and when you find a match, copy the value of the cell in rgSrcTable to the cell in rgDestTable.
Edit: Code sample. Feel free to adapt ranges to your needs. Since this routine used Range.Value property, you can filter any data (string, numbers, etc.)
Option Explicit
Sub CopyDataWithFilter()
Dim iRowHeader As Integer, iColHeader As Integer
Dim rngSrc As Range, rngDest As Range, celSrc As Range, celDest As Range
iRowHeader = 2
iColHeader = 1
With ThisWorkbook
' Set source and destination ranges. Modify ranges according to your needs
Set rngSrc = .Worksheets("shtSrc").Range("$B$3:$E$5")
Set rngDest = .Worksheets("shtDest").Range("$B$3:$E$5")
' Loop through source range and dest range
For Each celDest In rngDest
For Each celSrc In rngSrc
' Compare top headers and left headers respectively. If matching, copy the value in destination table.
If .Worksheets("shtSrc").Cells(celSrc.Row, iColHeader).Value = .Worksheets("shtDest").Cells(celDest.Row, iColHeader).Value And _
.Worksheets("shtSrc").Cells(iRowHeader, celSrc.Column).Value = .Worksheets("shtDest").Cells(iRowHeader, celDest.Column).Value Then
celDest.Value = celSrc.Value
End If
Next celSrc
Next celDest
End With
End Sub
Result: