Excel VBA to test and color cells of specific columns-CodePudding

So I have some "working code". Specifically, I am looking at a Range in Excel, then if I see "Yes" in a cell, coloring it Yellow and doing it for all the other cells in the range. Works GREAT.

Now I would like to sort of tweak the Fixed Range and have Excel look at the each column header and only perform this coloring based on the suffixes that I say. In this case, I would only like it to do this evaluation on the columns ending in "_ty".

Here is the code I have to color the entire range of cells:


Sub ColorCellRange()

    Dim c As Range

    ' Loop through all cells in range A1:E   last used Row in column A
    For Each c In Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)

        'Look for Yes
        If InStr(1, c.Text, "Yes", vbTextCompare) > 0 Then

            'Color the cell RED
            c.Offset(0, 0).Interior.Color = vbYellow

        End If
    Next

End Sub

Current output of code

CodePudding user response：

Another approach: scan the column headers and decide if to process the cells below.

Sub ColorCellRange()

    Dim c As Range, hdr As Range, ws As Worksheet
    
    Set ws = ActiveSheet  'or whatever
    'loop over all headers in Row 1
    For Each hdr In ws.Range("A1", ws.Cells(1, Columns.Count).End(xlToLeft)).Cells
        
        If hdr.Value Like "*_ty" Then 'is this a header we're interested in ?
            For Each c In ws.Range(hdr.Offset(1), ws.Cells(Rows.Count, hdr.Column).End(xlUp)).Cells
                If InStr(1, c.Text, "Yes", vbTextCompare) > 0 Then
                    c.Interior.Color = vbYellow
                End If
            Next c
        End If                        ' like "_ty"
    Next hdr
End Sub

CodePudding user response：

try this:

Option Compare Text  
Sub ColorCellRange()
    Dim c As Range
    For Each c In Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)
        If c.Value Like "*Yes*" And Cells(1, c.Column).Value Like "*_ty" Then
            c.Offset(0, 0).Interior.Color = vbYellow
        End If
    Next c
End Sub

or you can remove Option Compare Text and convert .value to low/upper case:

Sub ColorCellRange()
    Dim c As Range
    For Each c In Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)
        If LCase(c.Value) Like "*yes*" And _
            LCase(Cells(1, c.Column).Value) Like "*_ty" Then
            c.Offset(0, 0).Interior.Color = vbYellow
        End If
    Next c
End Sub