Conditional Formatting with VBA getting incorrect row values in final CF

welshgasman

welshgasman

Well-known Member
Joined
May 25, 2013
Messages
1,395
Office Version
  1. 2019
  2. 2007
Platform
  1. Windows
Hi all,
I had some help using Conditional Formatting in VBA in this thread. VBA apply conditional formatting

I have still not been able to work out what is going on. :-(
Does anyone have any clue please.

Basically Excel is replacing my target range with a very high number, near the limit of Excel rows.
I have walked through the code and checked that the values from the worksheet cells are passed in correctly, but those high numbers still get in there.

If I cannot get to the bottom of it, would anyone know a workaround?

1687800283285.png
1687800312685.png


Code: 
Sub Set_CF()
' https://www.mrexcel.com/board/threads/vba-apply-conditional-formatting.1220882/
' Created: 20221101
' By:      HaHoBe
' Version: 1
' Updated: 20221117
' Reason:  allowing more than one condition for CF
    Dim lngCounter As Long
    Dim rngToWork As Range
    Dim ws As Worksheet
    Dim wsCond As Worksheet
    Dim wsTarg As Worksheet

    On Error GoTo Error_CF
    Set wsCond = Worksheets("CF")
    If wsCond Is Nothing Then GoTo end_here
    On Error GoTo 0

    'Remove old conditional formatting
    '  For Each Ws In ThisWorkbook.Worksheets
    '    If Ws.Name <> wsCond.Name Then
    '      Ws.Cells.FormatConditions.Delete
    '    End If
    '  Next Ws
    ' Clear formatting
    '/// I would recommend to use the tab name here instead of any position
    Worksheets("SF66OEK").Cells.FormatConditions.Delete
    Worksheets("Passengers").Cells.FormatConditions.Delete
   
    'Set new formatting
    For lngCounter = 2 To wsCond.Range("A" & Rows.Count).End(3).Row
        On Error GoTo Error_CF
        Set wsTarg = Worksheets(wsCond.Cells(lngCounter, 1).Value)
        If wsTarg Is Nothing Then GoTo end_here
        Set rngToWork = wsTarg.Range(wsCond.Cells(lngCounter, 6).Value, wsCond.Cells(lngCounter, 7).Value)
        If rngToWork Is Nothing Then GoTo end_here
        On Error GoTo 0
        With rngToWork
            Debug.Print wsCond.Cells(lngCounter, 3).Value
            .FormatConditions.Add xlExpression, Formula1:=wsCond.Cells(lngCounter, 3).Value
            .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Font.ColorIndex = wsCond.Cells(lngCounter, 5).Value
            .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Interior.Color = wsCond.Cells(lngCounter, 4).Value
            .FormatConditions(wsCond.Cells(lngCounter, 8)).StopIfTrue = False

        End With
    Next lngCounter

end_here:
    If wsCond Is Nothing Then
        MsgBox "Check the name of the sheet with the parameters.", vbExclamation, "Name of sheet with parameters"
    ElseIf wsTarg Is Nothing Then
        MsgBox "Check the name of the target sheet", vbExclamation, "Could not find sheet"
    ElseIf rngToWork Is Nothing Then
        MsgBox "Could not build a range to work on, please check addresses.", vbExclamation, "Problems building range"
    End If

    Set rngToWork = Nothing
    Set wsTarg = Nothing
    Set wsCond = Nothing
    MsgBox "CF now reset on " & ActiveWorkbook.Name
    Exit Sub
Error_CF:
    MsgBox "Error in CF module " & Err.Description & " - " & Err.Number
    Resume end_here
End Sub
 
Sort by date Sort by votes
RoryA said:
You can apply multiple conditional formats as long as they don't contradict each other. If you have two rules that both apply a fill colour for example, obviously they can't both work. But if one uses a fill colour and another a font colour, then they can both apply at once (unless you used Stop if true).
Click to expand...
Well I started off just using Font Colour, but I do have 5 rules on one sheet.
I could check to see if a cell has a value before trying to apply the format.
I have already added two more columns for Bold and Italic.

Thank you both. AT least you got to the bottom of it.
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
You are welcome.
Glad we were able to help!
 
Upvote 0
Sorry for the delay in any reply.
I did not get any notifications of any new posts. :-(

Despite me having never messed with the preferences.
1690474428631.png
 
Upvote 0
Joe4 said:
Well, there it is! Nice detective work, Rory.

So he would need to write the rules to only change the things he wants changed (either Font.ColorIndex or Interior.Color), but not both for each and every rule or else that last one is going to win and overwrite everything prior to it.

welshgasman,
Maybe add two new columns, True/False fields for Update Font and Update Background, then code it into your script to only apply that part for each formula if those fields are True.
Click to expand...
Had a think about this when I woke up this morning. Sad I know. :)
It is actually the first rule that gets the honours. I gues that is why we have to delete the rules first, else we could just overwrite the rules.:unsure:

I might, just might amend it to set one facet of the CF, be it FontColor, ColorIndex, Bold or Italic. I can do that by leaving the CF cell empty and test for that.
 
Upvote 0
OK, I think I can live with this for the time being. :-)

Thanks again for the help.

1690533431645.png


Which poduces
1690533479855.png


Code: 
Sub Set_CF()
' https://www.mrexcel.com/board/threads/vba-apply-conditional-formatting.1220882/
' Created: 20221101
' By:      HaHoBe
' Version: 1
' Updated: 20221117
' Reason:  allowing more than one condition for CF
    Dim lngCounter As Long
    Dim rngToWork As Range
    Dim ws As Worksheet
    Dim wsCond As Worksheet
    Dim wsTarg As Worksheet

    On Error GoTo Error_CF
    Set wsCond = Worksheets("CF")
    If wsCond Is Nothing Then GoTo end_here
    'On Error GoTo 0

    'Remove old conditional formatting
    '  For Each Ws In ThisWorkbook.Worksheets
    '    If Ws.Name <> wsCond.Name Then
    '      Ws.Cells.FormatConditions.Delete
    '    End If
    '  Next Ws
    ' Clear formatting
    '/// I would recommend to use the tab name here instead of any position
    Worksheets("SF66OEK").Cells.FormatConditions.Delete
    'Worksheets("Passengers").Cells.FormatConditions.Delete
   
    'Set new formatting
    For lngCounter = 2 To wsCond.Range("A" & Rows.Count).End(3).Row
        On Error GoTo Error_CF
        Set wsTarg = Worksheets(wsCond.Cells(lngCounter, 1).Value)
        If wsTarg Is Nothing Then GoTo end_here
        Set rngToWork = wsTarg.Range(wsCond.Cells(lngCounter, 6).Value, wsCond.Cells(lngCounter, 7).Value)
        If rngToWork Is Nothing Then GoTo end_here
        On Error GoTo 0
        With rngToWork
            Range(wsCond.Cells(lngCounter, 6).Value).Select
            'Debug.Print wsCond.Cells(lngCounter, 3).Value
            .FormatConditions.Add xlExpression, Formula1:=wsCond.Cells(lngCounter, 3).Value
            If wsCond.Cells(lngCounter, 5).Value <> "" Then
                .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Font.ColorIndex = wsCond.Cells(lngCounter, 5).Value
            End If
            If wsCond.Cells(lngCounter, 4).Value <> "" Then
                .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Interior.Color = wsCond.Cells(lngCounter, 4).Value
            End If
            ' Set Bold or Italic
            If wsCond.Cells(lngCounter, 9).Value <> "" Then
                .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Font.Bold = wsCond.Cells(lngCounter, 9).Value
            End If
            If wsCond.Cells(lngCounter, 10).Value <> "" Then
                .FormatConditions(wsCond.Cells(lngCounter, 8).Value).Font.Italic = wsCond.Cells(lngCounter, 10).Value
            End If
            .FormatConditions(wsCond.Cells(lngCounter, 8)).StopIfTrue = wsCond.Cells(lngCounter, 11).Value

        End With
    Next lngCounter

end_here:
    If wsCond Is Nothing Then
        MsgBox "Check the name of the sheet with the parameters.", vbExclamation, "Name of sheet with parameters"
    ElseIf wsTarg Is Nothing Then
        MsgBox "Check the name of the target sheet", vbExclamation, "Could not find sheet"
    ElseIf rngToWork Is Nothing Then
        MsgBox "Could not build a range to work on, please check addresses.", vbExclamation, "Problems building range"
    End If

    Set rngToWork = Nothing
    Set wsTarg = Nothing
    Set wsCond = Nothing
    MsgBox "CF now reset on " & ActiveWorkbook.Name
    Exit Sub
Error_CF:
    MsgBox "Error in CF module " & Err.Description & " - " & Err.Number
    Resume end_here
End Sub
 
Upvote 0
Just FYI, the Formatconditions.Add method actually returns a reference to the new condition, so you should store that in a variable and reuse it instead of repeatedly calling .FormatConditions(wsCond.Cells(lngCounter, 8).Value)
 
Upvote 0
RoryA said:
Just FYI, the Formatconditions.Add method actually returns a reference to the new condition, so you should store that in a variable and reuse it instead of repeatedly calling .FormatConditions(wsCond.Cells(lngCounter, 8).Value)
Click to expand...
Hi @RoryA,
How would I do that please?
I could just use a count as well couldn't I, after you have pointed that out, as I discovered that it does not like missing a sequence?
 
Upvote 0
Like this:

Code: 
        Dim fc as object
        With rngToWork
            Range(wsCond.Cells(lngCounter, 6).Value).Select
            'Debug.Print wsCond.Cells(lngCounter, 3).Value
            set fc = .FormatConditions.Add(xlExpression, Formula1:=wsCond.Cells(lngCounter, 3).Value)
            If wsCond.Cells(lngCounter, 5).Value <> "" Then
                fc.Font.ColorIndex = wsCond.Cells(lngCounter, 5).Value
            End If
            If wsCond.Cells(lngCounter, 4).Value <> "" Then
                fc.Interior.Color = wsCond.Cells(lngCounter, 4).Value
            End If
            ' Set Bold or Italic
            If wsCond.Cells(lngCounter, 9).Value <> "" Then
                fc.Font.Bold = wsCond.Cells(lngCounter, 9).Value
            End If
            If wsCond.Cells(lngCounter, 10).Value <> "" Then
                fc.Font.Italic = wsCond.Cells(lngCounter, 10).Value
            End If
            fc.StopIfTrue = wsCond.Cells(lngCounter, 11).Value

        End With
 
Upvote 0
RoryA said:
Like this:

Code: 
        Dim fc as object
        With rngToWork
            Range(wsCond.Cells(lngCounter, 6).Value).Select
            'Debug.Print wsCond.Cells(lngCounter, 3).Value
            set fc = .FormatConditions.Add(xlExpression, Formula1:=wsCond.Cells(lngCounter, 3).Value)
            If wsCond.Cells(lngCounter, 5).Value <> "" Then
                fc.Font.ColorIndex = wsCond.Cells(lngCounter, 5).Value
            End If
            If wsCond.Cells(lngCounter, 4).Value <> "" Then
                fc.Interior.Color = wsCond.Cells(lngCounter, 4).Value
            End If
            ' Set Bold or Italic
            If wsCond.Cells(lngCounter, 9).Value <> "" Then
                fc.Font.Bold = wsCond.Cells(lngCounter, 9).Value
            End If
            If wsCond.Cells(lngCounter, 10).Value <> "" Then
                fc.Font.Italic = wsCond.Cells(lngCounter, 10).Value
            End If
            fc.StopIfTrue = wsCond.Cells(lngCounter, 11).Value

        End With
Click to expand...
OK, thank you. I will implement that as well.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
VBA , To consolidate two worksheet_chang events or to add events to another one
Replies
0
Views
499
ROUKWA
R
G
  • Solved
VBA to export .xlsb to .xlsx, values only (no formulas!)
Replies
8
Views
110
GVR16
G
J
  • Question Question
Multiple conditional formatting
Replies
6
Views
176
StephenCrump
S
R
  • Question Question
Having Trouble getting this code in VBA to work. Attempting to download a list of PDFs
Replies
1
Views
125
6StringJazzer
6StringJazzer
T
  • Solved
Modifying a Donut Chart
Replies
3
Views
120
Kaper
Kaper

Forum statistics

Threads
1,223,894
Messages
6,175,252
Members
452,623
Latest member
Techenthusiast

Share this page

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