vba - conditional highlighting based on values

Question

I have defined a range which is filled with color based on the keywords in the cells. The aim is the highlighting of keywords as seen in figure below. One sees that the word "Auto" is searched and the cell is marked red. Where I get stuck is to extent the "if" command such as the search criteria carries onto the column E looks after the keywords "Mortgage", "Preferred" and "non-Preferred" and marks it in some colors. These keywords are always located in row "E" and in the first four columns next to the keyword "Auto". The trouble is that the three keywords "Mortgage", "Preferred" and "non-Preferred" do not always appear in the same order. It is possible that the keyword "preferred" might appear before "Mortgage".

Thus, my main question is whether there is a command in VBA so that the highlighting of these Keywords is done in a dynamic way without using a static colomn number as the order of these keywords can change.

 Sub Schaltfläche2_Klicken()
 Dim cell As Range

 For Each cell In ws.Range("A1:A100")
 If cell.Value = "Auto" Then
    Range("A" & cell.Row, "E" & cell.Row, "G" & cell.Row, "I" & cell.Row, "K" & 
cell.Row).Interior.Color = vbRed
ElseIf cell.Value = "Mutti" Then
    Range("A" & cell.Row, "E" & cell.Row, "G" & cell.Row, "I" & cell.Row, "K" & 
cell.Row).Interior.Color = vbRed
End If
Next
End Sub

标签： vbaformattingconditionalhighlight

Answer 1

在 OP 关于避免白色的评论后编辑

你可以试试这个（评论中的解释）：

Sub Schaltfläche2_Klicken()
    Dim cell As Range, cell2 As Range, col As Long
    Dim ws As Worksheet
    Dim res As Variant

    Set ws = ActiveSheet

    For Each cell In ws.Range("A1:A100").SpecialCells(xlCellTypeConstants) ' loop thorugh column A not empty values
        Select Case cell.Value2 ' check current column A cell value and act accordingly
            Case "Auto"
                col = vbRed
            Case "Mutti"
                col = vbGreen ' change it as per your needs
            Case Else 'if no match
                col = 0
        End Select
        If col > 0 Then ' proceed only if a color has been established
            cell.Interior.Color = col
            For Each cell2 In cell.Offset(, 4).Resize(4).SpecialCells(xlCellTypeConstants)
                res = Switch(cell2.Value = "Mortgage", vbRed, cell2.Value = "Preferred", vbGreen, cell2.Value = "Nonpreferred", vbYellow) ' get color corresponding to cell value (change colors as per your needs)
                If Not IsNull(res) Then Intersect(Range("E:E, G:G, I:I"), Rows(cell2.Row)).Interior.Color = CLng(res) ' if any valid color, apply it
            Next
        End If
    Next
End Sub

看这里的Switch()功能

如果您需要颜色不同的标准颜色，您可以使用RGB()功能代替