I am new in VBA and would like to write a code which fills cells with xlookup formula.
I have 2 tables on different sheets but in the same workbook:
- on "New TS" sheet, I need to filter for the TBD-s in col H, and replace them with the exact value based on the data on the "Old TS" sheet.
- formula should to be used in the filtered range: =XLOOKUP(1, ('New TS'!C4='Old TS'!C2:C35) * ('New TS'!E4='Old TS'!E2:E35),'Old TS'!G2:G35,"TBD",0)
- C4 and E4 can change based on which row contains the first TBD
- Last row (now 35) can change based on the table on the Old TS sheet.
I would highly appreciate if you could help me how to add that to my code.
ThisWorkbook.Worksheets("New TS").range("1:1").AutoFilter Field:=8, Criteria1:="TBD"
endrow2 = ThisWorkbook.Worksheets("Old TS").range("G" & Rows.Count).End(xlUp).Row
firstrow = ThisWorkbook.Worksheets("New TS").range("H2:H" & Rows.Count).SpecialCells(xlCellTypeVisible).Cells().Row
ThisWorkbook.Worksheets("New TS").Cells(firstrow, 8) = Application.XLookup(1, (ThisWorkbook.Worksheets("New TS").range(firstrow, 3) = ThisWorkbook.Worksheets("Old TS").range("C2:C" & endrow2)) * (ThisWorkbook.Worksheets("New TS").range(firstrow, 5) = ThisWorkbook.Worksheets("Old TS").range("E2:E" & endrow2)), ThisWorkbook.Worksheets("Old TS").range("G2:G" & endrow2), "TBD", 0)
Please let me know if you need more information about that.
CodePudding user response:
Please see the screenshots about about the two sheets (examples only). I also attached screenshot about the errormgs and my code. I want to filter for TBDs on New TS and fill them with a value from Old TS. Then replace TBDs with "column H" value from old TS if: -the value in "new TS col C" can be found in "range: col C on old TS" AND -the value in "new TS col E" can be found in "range: col E on old TS". Please note, there could be hidden rows between two TBDs so the code should fill only the visible cells. Also last row can change based on the source pasted. I really appreciate your help.OldTS NewTSerrormsgmycode
CodePudding user response:
I've never been able to get the XLOOKUP
working in the same way as the formula when you have multiple criteria, as in your case.
My own implementation doesn't have to filter the range at all, just look for rows containing TBD
.
The other "trick" to the example solution here is in how you find a "matching" row. Your criteria is essentially a combination of data from two columns. Assuming that this combination is always unique, the solution is ideal for a Dictionary
. Each "key" to a dictionary entry is this unique combination of the two values.
(Another technique in the example below creates memory-based arrays from the worksheet range to speed processing.)
Option Explicit
Sub ReplaceTBDValues()
'--- capture the data into memory-based arrays
Dim newTSArea As Range
Dim newTS As Variant
Set newTSArea = ThisWorkbook.Sheets("New TS").UsedRange
newTS = newTSArea.Value
Dim oldTSArea As Range
Dim oldTS As Variant
Set oldTSArea = ThisWorkbook.Sheets("Old TS").UsedRange
oldTS = oldTSArea.Value
'--- create a Dictionary of the OldTS values for quick lookup
' the "key" for quick lookup is a combination of the values
' in columns C and E
Dim oldTSDict As Dictionary
Set oldTSDict = New Dictionary
Const NUMBER_COL As Long = 3
Const GROUP2_COL As Long = 5
Const OLD_TITLE_COL As Long = 8
Dim i As Long
For i = 2 To UBound(oldTS, 1) 'skip the header row
Dim tsKey As String
tsKey = oldTS(i, NUMBER_COL) & oldTS(i, GROUP2_COL)
If Not oldTSDict.Exists(tsKey) Then
'--- store the row number in the dictionary
oldTSDict.Add tsKey, i
Else
Debug.Print "Duplicate C/E values in row " & i & "!"
End If
Next i
'--- now run through the lines in New TS and replace the TBD data
For i = 2 To UBound(newTS, 1) 'skip the header row
If newTS(i, OLD_TITLE_COL) = "TBD" Then
Dim checkKey As String
checkKey = newTS(i, NUMBER_COL) & newTS(i, GROUP2_COL)
If oldTSDict.Exists(checkKey) Then
'--- found the values, so replace
newTS(i, OLD_TITLE_COL) = oldTS(oldTSDict(checkKey), OLD_TITLE_COL)
End If
End If
Next i
'--- finally copy the array back to the New TS sheet
newTSArea.Value = newTS
End Sub