VBA conditional format - variable range

[Swi1ch]

The sheets I distribute to team members have a large amount of conditional formatting. Rows and columns are frequently added/deleted/moved, causing havok with the conditionals in Excel's UI. I'm attempting to move all the conditionals to VBA with a 'Reset Colours' button for the end user to activate if something goes wrong.

As columns are rarely static, I need any functionality I create to be able to dynamically adjust. An example of this is with the filter in the attached workbook; I do not filter the column based it's reference, instead it is filtered based on cell content in a row hidden from the users. This way if they add or delete or move any columns, the filter functionality remains functioning.

I'm trying to get this to work with conditional formatting now. I succeeded in getting this to work with static cell references, which of course falls apart if anyone adds or deletes a column. I think i'm having two issues:

1. When my code loops to the first instance it finds of my target data, I can't figure out how to select the range that corresponds with that column, in order to set the range to apply the conditional formatting to.
2. The formula in the conditional formatting rule itself is set to a specific cell, which likely won't correspond to the range I want to format. Below the formula is applied to column F, but in my workbook I need to apply to both F and C.

Sub FormatTest_Click()

Dim Tracker As Worksheet
Set Tracker = Sheets("Tracker")
Dim Selection As Range

If MsgBox("Reset Conditional Formatting?", _
    vbYesNo, "Reset Conditional Formatting") = vbNo Then Exit Sub
    
    Tracker.Range("A:F").Select
    Selection.FormatConditions.Delete

For Each Selection In Range("A1:F1")
If Selection.Value = "Category 2" Then

'Do I need to Set a range here so that the next line can be:
'With range(****)
'If so, how?

.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=C1=""No"""  <-------------------------------------------------------'Need to have C1 here be the column that the Selection was found in.

Selection.FormatConditions(Selection.FormatConditions.Count).Priority = 1
    With Selection.FormatConditions(1).Interior
        .Color = 128
    End With
Selection.FormatConditions(1).StopIfTrue = False

End If

Next c

[Swi1ch]

So I worked on this some more and solved part of my problem. I assigned a name range to the ranges I want to be dynamic, so now at least if the columns move position my conditional formatting is still applied to it. However i'm still stuck, as I'm having to define the cell address in the formula, which will change when the columns change.

Sub Fix_Colours()

Dim Tracker As Worksheet
Set Tracker = Sheets("Tracker")

Application.EnableEvents = False

Tracker.Range("A:CA").Select
Selection.FormatConditions.Delete
Tracker.Range("A1").Select

With Range("NameRange") _
    .FormatConditions.Add(Type:=xlExpression, Formula1:="=$Q1=""Testing""")
        .Priority = 13
        .Font.Color = 16777215
        .Interior.Color = 15773696
        .StopIfTrue = False
    End With

Cells.FormatConditions(13).ModifyAppliesToRange Range("A:CA")

Application.EnableEvents = True

End Sub

[LJMetzger]

Hi Swi1ch,

I'm not a big fan of 'Conditional Formatting'. I propose the following 'Pseudo Conditional Formatting' alternative where VBA colors all the cells based on 'Header Names'.
In the Example:
Red = Sick and on Vacation (Holiday in UK)
Orange = Sick
Yellow = Vacation

Please note that there are two types of colors:
ColorIndex = Colors 1 thru 56 and xlNone
Color = RGB Colors (has no true xlNone equivalent)


See the attached sample file that contains the following code:

In the Sheet 'Tracker' code module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim sAddressRange As String
  
  'Turn Off Excel Events
  Application.EnableEvents = False
  
  'Get the Address(es) that changed
  sAddressRange = Target.Address(False, False)   '(False, False) removes '$' signs from the Address

  'Update the Status Cell
  If Target.Count = 1 Then
    Target.Parent.Range(sTrackerWorksheetColorCodeStatusCELL).Value = "Cell '" & sAddressRange & "' changed value - Colors are probably INCORRECT."
  Else
    Target.Parent.Range(sTrackerWorksheetColorCodeStatusCELL).Value = "Cells '" & sAddressRange & "' changed value - Colors are probably INCORRECT."
  End If
  
  'Enable Excel Events
  Application.EnableEvents = True
  
End Sub

In Ordinary Code Module ModConstantsAndGlobals (defines my Color Pseudo - Constants):

Option Explicit
'NOTE: If the Initialization Routine is not used all values are ZERO (o) = BLACK

'Color Pseudo-Constants
Public myRGB_NoColor As Long
Public myRGB_Black As Long
Public myRGB_Blue As Long
Public myRGB_Brown As Long
Public myRGB_Cyan As Long
Public myRGB_Gray As Long
Public myRGB_GrayUserFormDEFAULT As Long
Public myRGB_Green As Long
Public myRGB_Green2 As Long
Public myRGB_LightOrange As Long
Public myRGB_LightPurple As Long
Public myRGB_LightTan As Long
Public myRGB_Magenta As Long
Public myRGB_NavyBlue As Long
Public myRGB_Olive As Long
Public myRGB_Orange As Long
Public myRGB_PaleGreen As Long
Public myRGB_PaleYellow As Long
Public myRGB_Plum As Long
Public myRGB_Salmon As Long
Public myRGB_Red As Long
Public myRGB_White As Long
Public myRGB_Yellow As Long

Sub MyGlobalsInitialize()
  If myRGB_Red = 0 Then
    Call InitializeMyRGBs
  End If
End Sub

Sub InitializeMyRGBs()
  'NOTE: DO NOT CALL THIS ROUTINE - Call MyGlobalsInitialize
  myRGB_NoColor = 16777215 '256*256*256 - 1
  myRGB_Black = RGB(0, 0, 0)
  myRGB_Blue = RGB(0, 0, 255)
  myRGB_Brown = RGB(128, 0, 0)
  myRGB_Cyan = RGB(0, 255, 255)
  myRGB_Gray = RGB(128, 128, 128)
  myRGB_GrayUserFormDEFAULT = -2147483633
  myRGB_Green = RGB(0, 255, 0)
  myRGB_Green2 = RGB(0, 128, 64)
  myRGB_LightOrange = RGB(255, 153, 0)
  myRGB_LightPurple = RGB(204, 204, 255)
  myRGB_LightTan = RGB(255, 242, 204)
  myRGB_Magenta = RGB(255, 0, 255)
  myRGB_NavyBlue = RGB(0, 0, 100)
  myRGB_Olive = RGB(0, 64, 0)
  myRGB_Orange = RGB(255, 102, 0)
  myRGB_PaleGreen = RGB(204, 255, 204)
  myRGB_PaleYellow = RGB(255, 255, 153)
  myRGB_Plum = RGB(51, 102, 255)
  myRGB_Salmon = RGB(255, 128, 128)
  myRGB_Red = RGB(255, 0, 0)
  myRGB_White = RGB(255, 255, 255)
  myRGB_Yellow = RGB(255, 255, 0)
End Sub

In Ordinary Code Module ModPseudoConditionalFormatting:

Option Explicit

Public Const sTrackerWorksheetNAME = "Tracker"
Public Const sTrackerWorksheetColorCodeStatusCELL = "N3"


Sub ClearAllColors()

  Dim wb As Workbook
  Dim ws As Worksheet
  
  'Create the Worksheet Object
  Set wb = ThisWorkbook
  Set ws = wb.Sheets(sTrackerWorksheetNAME)
  
  'Turn Off Excel Events
  Application.EnableEvents = False
  
  'Clear All Colors from the Cells
  ws.Cells.Interior.ColorIndex = xlNone
  
  'Update the Status Cell
  ws.Range(sTrackerWorksheetColorCodeStatusCELL).Value = "All Colors were CLEARED from the Worksheet - Colors are probably INCORRECT."
  
  'Enable Excel Events
  Application.EnableEvents = True
  
  'Clear Object Pointers
  Set wb = Nothing
  Set ws = Nothing


End Sub

Sub ApplyPseudoConditionalFormatting()

  Const nHeaderROW = 4

  Dim wb As Workbook
  Dim ws As Worksheet
  
  Dim iColorRGB As Long
  Dim iRow
  Dim iRowLastUsed As Long
  Dim iNameColumn As Long
  Dim iDepartmentColumn As Long
  Dim iJobDescriptionColumn As Long
  Dim iJobCodeColumn As Long
  Dim iSickYesNoColumn As Long
  Dim iVacationYesNoColumn As Long
  
  Dim sSickValue As String
  Dim sVacationValue As String
  
  'Initialize Color Pseudo Constants
  Call MyGlobalsInitialize
  
  'Create the Worksheet Object
  Set wb = ThisWorkbook
  Set ws = wb.Sheets(sTrackerWorksheetNAME)
  
  'Turn Off Excel Events
  Application.EnableEvents = False
  
  'Get the Columns for the Various Header Items
  iNameColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "Name")
  iDepartmentColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "Department")
  iJobDescriptionColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "Job Description")
  iJobCodeColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "JOB CODE")
  iSickYesNoColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "Sick")
  iVacationYesNoColumn = GetColumnBasedOnHeaderValue(ws, nHeaderROW, "Vacation")
  
  'Get the Last Row Used
  iRowLastUsed = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
  
  'Color Name, Dept, Job Description, and Job Code Red if Sick and on Vacation
  'Color Name, Dept, Job Description, and Job Code Orange if on Sick
  'Color Name, Dept, Job Description, and Job Code Yellow if on Vacation
  For iRow = nHeaderROW + 1 To iRowLastUsed
  
    'Get the Sick Value (remove leading/trailing spaces) as UPPER CASE
    'Get the Vacation Value (remove leading/trailing spaces) as UPPER CASE
    sSickValue = UCase(Trim(ws.Cells(iRow, iSickYesNoColumn)))
    sVacationValue = UCase(Trim(ws.Cells(iRow, iVacationYesNoColumn)))
  
    'Get the Appropriate Color
    If sSickValue = "YES" And sVacationValue = "YES" Then
      iColorRGB = myRGB_Red
    ElseIf sSickValue = "YES" Then
      iColorRGB = myRGB_Orange
    ElseIf sVacationValue = "YES" Then
      iColorRGB = myRGB_Yellow
    Else
      iColorRGB = xlNone
    End If
  
    If iColorRGB = xlNone Then
      'Clear Color needs 'ColorIndex'
      ws.Cells(iRow, iNameColumn).Interior.ColorIndex = iColorRGB
      ws.Cells(iRow, iDepartmentColumn).Interior.ColorIndex = iColorRGB
      ws.Cells(iRow, iJobDescriptionColumn).Interior.ColorIndex = iColorRGB
      ws.Cells(iRow, iJobCodeColumn).Interior.ColorIndex = iColorRGB
    Else
      'RGB Colors need 'Color'
      ws.Cells(iRow, iNameColumn).Interior.Color = iColorRGB
      ws.Cells(iRow, iDepartmentColumn).Interior.Color = iColorRGB
      ws.Cells(iRow, iJobDescriptionColumn).Interior.Color = iColorRGB
      ws.Cells(iRow, iJobCodeColumn).Interior.Color = iColorRGB
    End If
      
  Next iRow

  'Update the Status Cell
  ws.Range(sTrackerWorksheetColorCodeStatusCELL).Value = "All Colors were UPDATED on the Worksheet on " & Format(Now(), "dddd mmm d, yyyy h:mm AMPM.")
  
  'Enable Excel Events
  Application.EnableEvents = True
  
  'Clear Object Pointers
  Set wb = Nothing
  Set ws = Nothing

End Sub

Function GetColumnBasedOnHeaderValue(ws As Worksheet, iHeaderRow As Long, sTargetText As String) As Long
  'This returns the Column Number to match the input 'Target Text' (CASE INSENSITIVE)
  'Zero (0) is returned if there is NO MATCH
  
  Dim r As Range
  
  'Find the first occurence of the string
  Set r = Nothing
  Set r = ws.Rows(iHeaderRow).Find(What:=sTargetText, _
                      After:=ws.Range("A" & iHeaderRow), _
                      LookIn:=xlValues, _
                      LookAt:=xlWhole, _
                      SearchOrder:=xlByColumns, _
                      SearchDirection:=xlNext, _
                      MatchCase:=False, _
                      SearchFormat:=False)
                      
                      
  If Not r Is Nothing Then
  
    'Save the found Column as the return value
    GetColumnBasedOnHeaderValue = r.Column
  End If
 
  'Clear the object pointer
  Set r = Nothing

End Function

Lewis

[Swi1ch]

Sorry I've taken ages to respond, I do appreciate the help. I'll try this out as soon as work eases up a bit.