Vlookup only cells in output range when interior color is blue

Question

I have a code where column "J" on the output sheet makes a vlookup in the pivot table on the source sheet. The vlookup is done on whole column "J". However in column "J" there are different colored cells like blue and grey.

I would like to adjust the code to only do the vlookup on the blue colored cells.

I searched here on stack and the net on how to do that. The only usefull thing I could find was :

For Each cell In Selection
   If cell.Interior.Color = vbBlue Then

I tried to implement the above in the code below but I couldn't make it work unfortunately. Maybe someone here can help or has a better idea...

Sub VlookWhenBlue()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim outputBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet

Application.ScreenUpdating = True

    'location of source and output workbook
    Set sourceBook = Workbooks.Open("C:\Users\...xlsm")
    Set outputBook = Workbooks.Open("C:\Users\....xls")
    
    'names of the worksheets
    Set sourceSheet = sourceBook.Worksheets("VAS pivot")
    Set outputSheet = outputBook.Worksheets("Invoice")

'last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

'last row in col
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "J").End(xlUp).Row

'apply formula
For i = 2 To OutputLastRow

    outputSheet.Range("J" & i).Formula = "=IFERROR(VLOOKUP(D" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$B$5:$E$" & SourceLastRow & ",3,0),0)"
    
Next i

Application.ScreenUpdating = True

End Sub

Edit: this is the updated none working version:

Sub VlookWhenBlue()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim outputBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet



Application.ScreenUpdating = True

    'location of source and output workbook
    Set sourceBook = Workbooks.Open("C:\Users\...xlsm")
    Set outputBook = Workbooks.Open("C:\Users\...xls")
    
    
    'names of the worksheets
    Set sourceSheet = sourceBook.Worksheets("VAS pivot")
    Set outputSheet = outputBook.Worksheets("Invoice")

'last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

'last row in col
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "J").End(xlUp).Row

'apply formula

Dim cell As Range


For Each cell In outputSheet.Range("J4:J" & OutputLastRow).Cells

If cell.Interior.ColorIndex = 15773696 Then

    outputSheet.Range("J" & i).Formula = "=IFERROR(VLOOKUP(D" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$B$5:$E$" & SourceLastRow & ",3,0),0)"
    
    Else
    'do nothing
End If
Next


Application.ScreenUpdating = True

End Sub

Answer 1

There are two ways I would approach this, depending on the exact situation.

If you are writing a UDF which is being called from a worksheet cell, then you'll need to loop through the cells.

The following returns a value if there is an exact match (eg range_lookup=False in the VLOOKUP function.

Function colVlookup(lookupValue, tableArray, colNum)
    Const clr As Long = 15773696
    Dim C As Range
    Dim res
    
For Each C In tableArray
    If Not IsEmpty(res) Then Exit For
    If C.Interior.color = clr And C.value = lookupValue Then _
        res = C.Offset(columnoffset:=colNum - 1).value
Next C
    
If Not IsEmpty(res) Then
    colVlookup = res
Else
    colVlookup = CVErr(xlErrNA)
End If

End Function

You would enter this in some worksheet cell as:

=colVlookup("genus",Input,2)

---

If you are writing a macro (Sub) procedure which will write the results to an output range, then you can use the Range.Find method.

The following function must be called from, and return the result to and Sub. That Sub can then write the results to the worksheet wherever you wish

Option Explicit
Sub cvl()
    Dim x
x = colorVlookup("genus", [Input], 2)
With Range("Output")
    .Clear
    .value = x
End With
End Sub
'--------------------------------
Function colorVlookup(lookupValue, tableArray As Range, colNum As Long)
    Const clr As Long = 15773696
    Dim C As Range
    
With Application.FindFormat
    .Clear
    .Interior.color = clr
End With

With tableArray.Columns(1)
    Set C = .Find(what:=lookupValue, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, searchformat:=True)
    If Not C Is Nothing Then
        colorVlookup = C.Offset(columnoffset:=colNum - 1).value
    Else
        MsgBox "Not Found"
    End If
End With

End Function

As written, the above routines will return the First match, but you could modify them to return the last match, or even an array of all the matches.

They also look for an exact match, but could be modified to look for partial matches.

Note in the screenshot below that the routine is returning the second match of genus since the first instance is NOT blue.