VBA for conditional formatting

handysmurf

Board Regular
Joined
Jan 17, 2015
Messages
114
Office Version
  1. 365
Platform
  1. Windows
First let me say that I tried for 3 hours to figure this out myself before posting ... to no avail.

Second, I want to use VBA to do conditional formatting because the conditional formatting panel becomes too cumbersome ... as I make changes or move things around the whole thing becomes cluttered with duplicates working on different ranges and it then takes forever and a day to restore it to the base set of conditions/formatting.

So ... here is what I need to accomplish.... I can manage to duplicate a sub and change colors and names once I have a working code. So I really only need probably 3 different subs? If I can get that accomplished I would like it to refresh/update whenever I save (I save very often so I figured that would be a good trigger) ... so one to call all the subs? I might be able to figure that one out on my own.
Excel.png
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
I recommend creating a table with the names, for example in columns AA to AD, that way it will be easier to add names and it will not be necessary to modify the conditional formats or the macro.

And also in cell 1 of each name list, put the color you need for those names, then the macro will take the color of cells AA1, AB1, AC1 and AD1, see my example:

Dante Amor
AAABACAD
1FormatFormatFormatFormat
2ChattaStevenTiara6760
3Jenna
4Jerri
5JJ
6JOSH
7Kendra
8Shelly
9Shiela
10Tim
Sheet1



Once the above is created.

Use the following macro to create all conditional formatting:
VBA Code:
Sub conditional_formatting()
  Dim lr As Long, i As Long
  Dim arr As Variant
 
  Sheets("Sheet1").Select
  Cells.FormatConditions.Delete
  lr = Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  arr = Array("$AA:$AA", "AA1", "$AB:$AB", "AB1", "$AC:$AC", "AC1", "$AD:$AD", "AD1")
 
  With Range("A3:K" & lr)
    For i = 0 To UBound(arr) Step 2
      .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(" & arr(i) & ",$J3)"
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
      .FormatConditions(1).Interior.Color = Range(arr(i + 1)).Interior.Color
      .FormatConditions(1).StopIfTrue = False
    Next
  End With
 
  With Range("A3:L" & lr)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=$H3=""Parenting"""
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorAccent2
      .TintAndShade = 0.599963377788629
    End With
    With .FormatConditions(1).Font
      .Bold = True
      .Color = -16776961
    End With
    With .FormatConditions(1).Borders(xlTop)
      .LineStyle = xlContinuous
      .TintAndShade = 0
      .Weight = xlThin
    End With
    .FormatConditions(1).StopIfTrue = False
  End With
 
  With Range("M3:O" & lr)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=$H3=""Parenting"""
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorAccent4
      .TintAndShade = 0.599963377788629
    End With
    With .FormatConditions(1).Font
      .Bold = True
      .Color = -16776961
    End With
    .FormatConditions(1).StopIfTrue = False
  End With
 
  With Range("P3:R" & lr)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=$H3=""Parenting"""
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorAccent6
      .TintAndShade = 0.599963377788629
    End With
    With .FormatConditions(1).Font
      .Bold = True
      .Color = -16776961
    End With
    .FormatConditions(1).StopIfTrue = False
  End With
 
  With Range("A3:K" & lr)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($H3<>""Parenting"",$A3=$A4,$G3<>$G4)"
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .FormatConditions(1).StopIfTrue = False
  End With
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
 
Upvote 1
I forgot to mention that you must adjust the name of the sheet where you have the formats in this line:
Sheets("Sheet1").Select


I simplified the code a bit, copy all the following code and try with the conditional_formatting macro:
VBA Code:
Sub conditional_formatting()
  Dim lr As Long, i As Long
  Dim arr As Variant
  Application.ScreenUpdating = False
 
  Sheets("Sheet1").Select
  Cells.FormatConditions.Delete
  lr = Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  arr = Array("$AA:$AA", "AA1", "$AB:$AB", "AB1", "$AC:$AC", "AC1", "$AD:$AD", "AD1")
 
  With Range("A3:K" & lr)
    For i = 0 To UBound(arr) Step 2
      .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(" & arr(i) & ",$J3)"
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
      .FormatConditions(1).Interior.Color = Range(arr(i + 1)).Interior.Color
      .FormatConditions(1).StopIfTrue = False
    Next
  End With
 
  Call format_2("A3:L" & lr, xlThemeColorAccent2, True)
  Call format_2("M3:O" & lr, xlThemeColorAccent4, False)
  Call format_2("P3:R" & lr, xlThemeColorAccent6, False)

  With Range("A3:K" & lr)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($H3<>""Parenting"",$A3=$A4,$G3<>$G4)"
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .FormatConditions(1).StopIfTrue = False
  End With
  Application.ScreenUpdating = True
End Sub

Sub format_2(rng As String, xl_Theme As XlThemeFont, xl_Border As Boolean)
  With Range(rng)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=$H3=""Parenting"""
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xl_Theme
      .TintAndShade = 0.599963377788629
    End With
    With .FormatConditions(1).Font
      .Bold = True
      .Color = -16776961
    End With
    If xl_Border Then
      With .FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
      End With
    End If
    .FormatConditions(1).StopIfTrue = False
  End With
End Sub

Regards
Dante Amor
😇
 
Upvote 0
Well ... forgot the lesson .. read the entire thread first. The first code is what I put in and it works great. Thank you soo much ... that will save me days (cumulatively) of my life. LOL
 
Upvote 0
Welp ... I have no idea what happened but it stopped working properly .... So I had to delete all CF, and re-paste the script and change the references. But that is just fine. I took me like 3 minutes to do that compared with hours of deleting duplicated Rules.

meh ... I don't need a fix ... just putting the info in here for anyone that tries to use this later.
 
Upvote 0
Welp ... I have no idea what happened but it stopped working properly .... So I had to delete all CF, and re-paste the script and change the references. But that is just fine. I took me like 3 minutes to do that compared with hours of deleting duplicated Rules.

meh ... I don't need a fix ... just putting the info in here for anyone that tries to use this later.
I figured out that all i need to do is erase formatting and run the script again.
 
Upvote 0
I need to move the "formatting table" to a different sheet because I'm making changes that kept moving the table around. I want to fix that by having a dedicated sheet just for the table. So the new location for the table is on the "Formatting" sheet but I still want it to apply to the "Day2Day" sheet. I managed to figure out how change the sheet reference for the table and the column settings in the code but I don't know how to make it apply to the "Day2Day" sheet.

Thank you so much in advance.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top