A VBA Lookup: Lookup Headers in an Excel Table
-
Evaluating in either flavor will not work with this kind of formula.
-
After you have written the formulas you could copy/paste values e.g.:
Dim rg As Range: Set rg = Range("A1").CurrentRegion
rg.Value = rg.Value
This will also copy the headers but they won't mind.
-
If you want to be more accurate and exclude the headers (Shops and Regions), use:
With rg.Resize(rg.Rows.Count - 1, rg.Columns.Count - 1).Offset(1, 1)
.Value = .Value
End With
Sub UpdateData()
' Constants
Const SRC_SHEET As String = "Sheet1"
Const SRC_TABLE As String = "Shop"
Const SRC_ROWS As String = "Name"
Const SRC_COLUMNS As String = "Region"
Const SRC_VALUES As String = "Sales"
Const DST_SHEET As String = "Sheet1"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source to Arrays
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim slo As ListObject: Set slo = sws.ListObjects(SRC_TABLE)
Dim srCount As Long: srCount = slo.DataBodyRange.Rows.Count
Dim srData(): srData = slo.ListColumns(SRC_ROWS).DataBodyRange
Dim scData(): scData = slo.ListColumns(SRC_COLUMNS).DataBodyRange
Dim svData(): svData = slo.ListColumns(SRC_VALUES).DataBodyRange
' Destination to Dictionaries
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion
' Names
Dim drCount As Long: drCount = drg.Rows.Count - 1
Dim drData(): drData = drg.Resize(drCount, 1).Offset(1).Value
Dim rDict As Object: Set rDict = CreateObject("Scripting.Dictionary")
rDict.CompareMode = vbTextCompare
Dim dr As Long
For dr = 1 To UBound(drData, 1)
rDict(drData(dr, 1)) = dr
Next dr
Erase drData
' Region
Dim dcCount As Long: dcCount = drg.Columns.Count - 1
Dim dcData(): dcData = drg.Resize(1, dcCount).Offset(, 1).Value
Dim cDict As Object: Set cDict = CreateObject("Scripting.Dictionary")
cDict.CompareMode = vbTextCompare
Dim dc As Long
For dc = 1 To UBound(dcData, 2)
cDict(dcData(1, dc)) = dc
Next dc
Erase dcData
' Values
Dim dvData(): ReDim dvData(1 To drCount, 1 To dcCount)
' Dictionary to Destination Values Array
Dim sr As Long
For sr = 1 To srCount
If rDict.Exists(srData(sr, 1)) Then
If cDict.Exists(scData(sr, 1)) Then
dvData(rDict(srData(sr, 1)), cDict(scData(sr, 1))) _
= svData(sr, 1)
End If
End If
Next sr
' Destination Values Array to Destination Range
With drg.Resize(drCount, dcCount).Offset(1, 1)
.ClearContents
.Value = dvData
End With
' Inform.
MsgBox "Data updated.", vbInformation
End Sub