Search code examples
excelvbaconditional-formatting

Applying a conditional formatting macro to a table in current sheet instead of a named table


I have recorded a macro that corrects the conditional formatting rules of a table every time they get messed up (because of adding or removing lines I suppose…) And I put a button to activate the macro in the sheet I need to replicate the same table in several sheets (increasing number of sheets) and I want my macro to function on all of them (not necessarily simultaneously) in addition of having this common table, most of the sheets have other tables also, but there will be 1 table that will be replicated in MOST sheets. (Basically create a template sheet containing the table and macro button that users will replicate for each new client Since the tables will have same number of columns and column titles, is it possible to tweak it so it works on any table where the cursor has selected a cell? Or similar? Maybe some way of changing the ref from “bookingInfo” to “selected table” FYI: I do not know how to write VBA at all

Here is the code I have:

Application.ScreenUpdating = False

Application.Goto Reference:="BookingInfo"
Selection.ListObject.Range.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$B4<>$B5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .Bold = True
    .Italic = False
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A5<>"""""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .Pattern = xlLightDown
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=$AN5=""Full PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent3
    .TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=$AN5=""Partial PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False

Application.ScreenUpdating = True End Sub

Any Help?


Solution

  • You could do it like this:

    Sub CFUpdate()
        
        Dim lo As ListObject, rng As Range
        
        Set lo = Selection.ListObject
        If lo Is Nothing Then 'is the selection in a listobject?
            MsgBox "First select any cell in the Table to be updated", vbExclamation
            Exit Sub  'nothing to do...
        End If
        
        Set rng = lo.DataBodyRange  'range to be formatted
        rng.FormatConditions.Delete
        
        With AddFC(rng, xlExpression, "=$B4<>$B5").Font
            .Bold = True
            .Italic = False
            .TintAndShade = 0
        End With
        
        With AddFC(rng, xlExpression, "=$A5<>""""").Interior
            .Pattern = xlLightDown
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.14996795556505
        End With
        
        With AddFC(rng, xlExpression, "=$AN5=""Full PMT""").Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.399945066682943
        End With
        
        With AddFC(rng, xlExpression, "=$AN5=""Partial PMT""").Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.399945066682943
        End With
        
        Application.ScreenUpdating = True
    End Sub
    
    'factoring out some common steps
    Function AddFC(rng As Range, fcType As XlFormatConditionType, frmla As String)
        Dim fc As FormatCondition
        Set fc = rng.FormatConditions.Add(Type:=fcType, Formula1:=frmla)
        fc.StopIfTrue = False
        Set AddFC = fc 'return the FormatCondition we just added
    End Function
    

    Pulled some of the common code out into a separate function to reduce the bulk of the code when adding each format condition.

    Note you'll also need to adjust the formulas if the tables don't all start on the same row...