Fill blanks with Value found with XLOOKUP in vba

Question

I have been trying to write some worthy piece of code but this keeps on failing, so was hoping on your expertise to help me out ;)

My table looks a little like the below:

And I need to fill in the blank with the following criteria:

If a field is empty, it needs to be filled with the value of Same country/Yellow/same year so Australia/green/2022 is empty so it needs to be filled by the value of Australia/Yellow/2022
If same country/yellow/same year is empty as well, then we take the value of the region/same color/same year as both australia/green/2022 and Australia/Yellow/2022 are empty, we need the value of Asia/green/2022
If that is empty as well, then we go Region/Yellow/same year so we would look for Asia/Yellow/2022 if the previous needed values are empty..

This is what I wrote for the first level (looking for same country/yellow/same year) but can't get the right thing to pinpoint the "results".

Sub Test()

Dim WB As Workbook
Dim WS As Worksheet
Set WB = ActiveWorkbook
Set WS = WB.Sheets("BASIS")

Dim LRow As Long, LCol As Long, r As Long, c As Long

LRow = WS.Range("B" & WS.Rows.Count).End(xlUp).Row
LCol = WS.Cells(LRow, 29)

Dim criteria1, criteria3, search1, search2, search3 As Range
Dim results As Range

Application.ScreenUpdating = False

For c = 8 To LCol
    For r = 3 To LRow - 1
        If WS.Cells(r, c) = "" Then
        
            criteria1 = WS.Cells(r, 4)
            criteria3 = WS.Cells(r, 6)
            criteria4 = WS.Cells(2, c)

            
            search1 = WS.Range("D3:D" & LRow)
            search2 = WS.Range("E3:E" & LRow)
            search3 = WS.Range("F3:F" & LRow)
            search4 = WS.Range("H2:AC2")
            
            results = WS.Range("H3:AC" & LRow)

        
        
            WS.Cells(r, c).Value = Application.WorksheetFunction.XLookup(criteria1 & "Yellow" & criteria3 & criteria4, search1 & search2 & search3 & search4, results).Value
            'ws.Cells(LRow, c).Value
        End If
    Next r
Next c

Application.ScreenUpdating = True

End Sub

Maybe one of you may help :)

If there are more regions from which one to choose the corresponding color? — Black cat, Jul 03 '23 at 11:30
Europeans countries -> Europe | Asian countries / Australia / New Zealand -> Asia | African countries -> Africa | South american countries -> South America | North american countries -> North America — Elisa R., Jul 03 '23 at 12:37
Sorry i mean in your example why Asia and not AsiaPacific? Always has to use Asia as base? — Black cat, Jul 03 '23 at 12:42
Just see Australia as "Banana" and Asia as "Fruits". I just need code to get the values, does not matter if it comes from Asia or Asia Pacific, just need an example of right coding. thanks — Elisa R., Jul 03 '23 at 13:18

Black cat · Answer 1 · 2023-07-04T11:36:30.267

This snippet for an example does the following.

Get the nearest previous "Yellow" value in the same column for an empty cell.

If no previous value for "Yellow" in the column an error message is generated.

This is the table for testing

The code:

Sub fillexamp()

Dim collect() As Variant

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
j = 0
For i = 3 To lastrow
If Cells(i, 2) = "Yellow" And InStr(1, Cells(i, 1), "Asia") <> 0 Then
    ReDim Preserve collect(1, j)
    collect(0, j) = Cells(i, 1)
    collect(1, j) = i
    j = j + 1
End If
Next i
j = j - 1
For cols = 4 To 6
For xrow = 3 To lastrow
    If IsEmpty(Cells(xrow, cols)) Then
replaced = False
For k = j To 0 Step -1
If Not IsEmpty(Cells(collect(1, k), cols)) And collect(1, k) < xrow Then
    Cells(xrow, cols) = Cells(collect(1, k), cols)
    replaced = True
    Exit For
End If
Next k
If Not replaced Then MsgBox "No fill value found!", vbOKOnly + vbCritical, "ERROR IN FILL": Exit Sub


End If
Next xrow
Next cols
End Sub

Sorry for not having been clear in my comments above. I meant we could either take Asia or Asia Pacific for Australia, not any Yellow associated value. For example I cannot take France/Yellow/2022 as a replacement for the missing Australia/Yellow/2022 value.. The code should really look for Region of Country/Yellow/2022.. But in the beginning, we were looking for Australia/Yellow/2022 as Australia/green/2022 was missing... Thank you — Elisa R., Jul 04 '23 at 09:05
@elisa i added modification. The code was adapted to your sample table what is sorted by (Region/Country) and Yellow is the first row of each. — Black cat, Jul 04 '23 at 11:45

Fill blanks with Value found with XLOOKUP in vba

1 Answers1