VBA for conditional formatting

[handysmurf]

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.

 

[DanteAmor]

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
	AA	AB	AC	AD
1	Format	Format	Format	Format
2	Chatta	Steven	Tiara	6760
3	Jenna
4	Jerri
5	JJ
6	JOSH
7	Kendra
8	Shelly
9	Shiela
10	Tim
Sheet1

Once the above is created.

Use the following macro to create all conditional formatting:

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
----- --

 

[DanteAmor]

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:

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

 

[handysmurf]

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

 

[handysmurf]

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.

 

[handysmurf]

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.

 

[handysmurf]

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.

 

[handysmurf]

.Bump