CODEWITHSUNDEEP
vbaexcel
Ctk Kim
Ctk Kim

Reputation: 3

Excel VBA Loop to fill column based on column header

So I have a pivot table that is updated from SQL database everyday. I want to highlight the whole section that days >5, but since data is updated daily, conditional formatting does not work. I created a dynamic range (see below), now I need it to run a loop to find where column 29 (where the days are next to name) is greater then 5 I need everything below to be highlighted in red as my attachment shows. Any help or suggestions? I know this is pretty complex.

CODE:

Sub dynamicRange()

    'Disable certain Excel featured whilst Macro is running
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'Declare variables
    Dim startCell As Range, lasRow As Long, lastCol As Long, ws As Worksheet

    'Set Objects
    Set ws = Sheet4
    Set startCell = Range("N30")

        'Find last row and column of data
        lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
        lastCol = ws.Cells(startCell.Row, ws.Columns.Count).End(xlToLeft).Column

        'Select dynamic ramge of data
        ws.Range(startCell, ws.Cells(lastRow - 1, lastCol - 1)).Select


    'Re-enable certain Excel features after macro has run
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

enter image description here

Upvotes: 0

Views: 3162

Answers (1)

ye-olde-dev
ye-olde-dev

Reputation: 1298

Howdee, this should get the job done for you. Just assign the ws variable to the sheet you want to run on. Let me know if you have any questions.

Sub ColorFill()
Dim ws As Worksheet
Dim rngColor As Range, rngHeader
Dim lastRow As Long, lastCol As Long, firstRow, firstCol

'Set Sheet to desired sheet
Set ws = Sheet1

'find top left of range
firstRow = ws.UsedRange.Row
firstCol = ws.UsedRange.Column

'find bottom right of range
lastRow = firstRow + ws.UsedRange.Rows.Count - 1
lastCol = firstCol + ws.UsedRange.Columns.Count - 1

'set range of headers
Set rngHeader = Range(Cells(firstRow, firstCol + 1), Cells(firstRow, lastCol))

'loop through range of headers and color column
For Each cell In rngHeader
If cell.Value > 5 Then
    Set rngColor = Range(cell.Offset(1, 0), Cells(lastRow, cell.Column))
    rngColor.Interior.ColorIndex = 3
End If
Next

End Sub

Upvotes: 1

Related Questions