I am trying to write a VBA function for two purposes:

1. Sub ApplyConditonalFormatting to loop through the column headers, if the header contains certain text, make it this color (based on RGB scale)
2. Sum By Color function to then sum all the integers in the columns with that color

I tried the following and adjusted for my excel sheet, but it did not work. I need to get conditional formatting to work first and then do the SumColor function. Is there something wrong with my syntax or the code itself? I wondered if it was the way my excel sheet was set up as I have a legend/instructions at the top and the headers don't start until row 16.

Sub ApplyConditionalFormatting()
    Dim ws As Worksheet
    Dim targetText As String
    Dim cell As Range
    Dim startCell As Range
    Dim lastRow As Long
    
    ' Set the worksheet and target text
    Set ws = ThisWorkbook.Sheets("Sheet1")
    targetText = "TargetText"
    
    ' Find the cell containing the target text in column A
    Set startCell = ws.Columns("A").Find(What:=targetText, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' If the target text is found
    If Not startCell Is Nothing Then
        ' Determine the last row in the column
        lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
        
        ' Apply the color to all cells below the found cell
        For Each cell In ws.Range(startCell.Offset(1, 0), ws.Cells(lastRow, startCell.Column))
            cell.Interior.Color = RGB(255, 255, 0) ' Yellow color
        Next cell
    Else
        MsgBox "Target text not found in column A."
    End If
End Sub

I am trying to write a VBA function for two purposes:

1. Sub ApplyConditonalFormatting to loop through the column headers, if the header contains certain text, make it this color (based on RGB scale)
2. Sum By Color function to then sum all the integers in the columns with that color

I tried the following and adjusted for my excel sheet, but it did not work. I need to get conditional formatting to work first and then do the SumColor function. Is there something wrong with my syntax or the code itself? I wondered if it was the way my excel sheet was set up as I have a legend/instructions at the top and the headers don't start until row 16.

Sub ApplyConditionalFormatting()
    Dim ws As Worksheet
    Dim targetText As String
    Dim cell As Range
    Dim startCell As Range
    Dim lastRow As Long
    
    ' Set the worksheet and target text
    Set ws = ThisWorkbook.Sheets("Sheet1")
    targetText = "TargetText"
    
    ' Find the cell containing the target text in column A
    Set startCell = ws.Columns("A").Find(What:=targetText, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' If the target text is found
    If Not startCell Is Nothing Then
        ' Determine the last row in the column
        lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
        
        ' Apply the color to all cells below the found cell
        For Each cell In ws.Range(startCell.Offset(1, 0), ws.Cells(lastRow, startCell.Column))
            cell.Interior.Color = RGB(255, 255, 0) ' Yellow color
        Next cell
    Else
        MsgBox "Target text not found in column A."
    End If
End Sub

• excel
• vba

• 2 "it did not work" - what did it do (or not do) that was different from what you expect? Did you try debugging your code to see what path it took when you ran it? – Tim Williams Commented Mar 17 at 17:02
• 1 Side note: your For Each loop can be replaced by a single statement. – BigBen Commented Mar 17 at 17:05
• 4 Why sum by color? It seems you already know what the condition is you use to apply the color, so use that same rule to conditionally sum. – jkpieterse Commented Mar 17 at 17:07
• to loop through the column headers - so why search rows in column("A") with ws.Columns("A").Find(). Maybe that should be ws.Rows(16).Find(). – CDP1802 Commented Mar 17 at 19:24

1 Answer 1

Loop Through Matching Columns

• It highlights the matching headers (containing "Sum") and sums up the corresponding data below.

Sub HighlightAndSumupColumns()
    
    ' Define constants.
    Const SHEET_NAME As String = "Sheet1"
    Const FIRST_COLUMN As String = "A"
    Const FIRST_HEADER_TITLE As String = "TargetText"
    Const HEADER_CONTAINS_STRING As String = "Sum"
    Dim HEADER_COLOR As Long: HEADER_COLOR = vbYellow ' or = 'RGB(255,255,0)'
    
    ' Reference the workbook and worksheet.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(SHEET_NAME)
    
    ' Reference the first cell of the header row.
    Dim fcell As Range: Set fcell = ws.Columns(FIRST_COLUMN) _
        .Find(What:=FIRST_HEADER_TITLE, LookIn:=xlFormulas, LookAt:=xlWhole)
    If fcell Is Nothing Then
        MsgBox "Could not find the title """ & FIRST_HEADER_TITLE _
            & """ in column """ & FIRST_COLUMN & """ of sheet """ _
            & ws.Name & """!", vbExclamation
        Exit Sub
    End If
    
    ' Reference the last cell of the header row.
    Dim lcell As Range: Set lcell = ws.Rows(fcell.Row) _
        .Find(What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)
    
    ' Reference the header row and clear existing highlights.
    Dim hrg As Range: Set hrg = ws.Range(fcell, lcell)
    hrg.Interior.ColorIndex = xlNone ' clear existing highlights
    
    ' Reference the data (below the headers).
    ' Assuming there is data, just data, below the headers!!!
    Dim drg As Range:
    With ws.UsedRange
        Set drg = hrg.Resize(.Rows.Count + .Row - hrg.Row - 1).Offset(1)
    End With
    
    ' Declare additional variables.
    Dim cell As Range, Col As Long, HeaderTitle As String, Total As Double
    
    ' Loop through the cells of the header row and highlight
    ' each matching header and sum up its corresponding data (below).
    For Each cell In hrg.Cells
        Col = Col + 1
        HeaderTitle = cell.Value
        If InStr(1, HeaderTitle, HEADER_CONTAINS_STRING, vbTextCompare) > 0 Then
            cell.Interior.Color = HEADER_COLOR
            ' If you also want to highlight the data, use:
            'drg.Columns(Col).Interior.Color = HEADER_COLOR
            Total = Total + Application.Sum(drg.Columns(Col))
            ' Assuming there are no error values!!!
        End If
    Next cell
    
    ' Inform.
    MsgBox "Headers highlighted. The sum is " & Total & ".", vbInformation

End Sub