xlookup on filtered range

Viktória Bernád 0
Viewed 56

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:

  1. 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.
  2. 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)
  3. C4 and E4 can change based on which row contains the first TBD
  4. 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.

xlookup formula vba excel
1 Answers

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
userrkNj0
Related