Conditional Formatting with VBA getting incorrect row values in final CF

[welshgasman]

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?

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

 

[Joe4]

Why are you looping through each cell in your range separately and applying Conditional Formatting rules for each cell individually?
You can apply Conditional Formatting to a whole range of cells at one time without having to loop through each cell in the range to do it.

 

[welshgasman]

TBH Joe,
I just accepted the code as it was given.
I have modified it a little now trying to get to the bottom of this issue, but the logic remains the same?

How would you apply the formatting then?

Edit: I do not believe I am, that is walking through the rows in the CF sheet that holds the settings for the CF? See last pic?
The range is rngtoWork which when debugging is correct?

 

[Joe4]

OK, I think maybe I misunderstood the initial question.
So, is it that you have a listing of rules that you want to create listed on an Excel sheet, and you are looping through those specifications to create the various Conditional Formatting Rules via VBA?

If so, can you re-post the Excel grid of formula rules either by using the XL2BB utility, or using Copy/Paste, so I can easily copy those over so I can work off of the same data you are?
I really not prefer to type each of those in manually. Besides being a slow typist, there is also a good chance that I may make some typos!

 

[welshgasman]

Yes to both.
The reason I am doing this is when I need extra rows and copy the formulae, I end up with multiple CFs of the same criteria and settings.
Just trying to get the onse set per sheet.

GCD.xlsm
	A	B	C	D	E	F	G	H	I	J
1	SheetCell	Rule Type	Rule Rescription	Fill Colour	Font Colour	Applies From	Applies To	Order	Colour	SortOrder
2	SF66OEK	Formula:=	=Left($E4,9) = "Cancelled"	16777215	1	$A4	$L73	1	Red	1A
3	SF66OEK	Formula:=	=$K4 = "Yes"	16777215	4	$A4	$L73	2	Green	2A
4	SF66OEK	Formula:=	=AND($H4=$J4,$G4<>"")	16777215	26	$A4	$L73	3	Magenta	3A
5	SF66OEK	Formula:=	=$O4 > 0	65280	1	$A4	$L73	4	Green	4A
6	Passengers	Formula:=	=$L2 = "No"	16777215	3	$A2	$L500	1	Red	1B
CF

 

[Joe4]

Hmmm... When I copied those rules and the code, I could not recreate the issue you mention about the high number rows.
Are you inserting, deleting, or copying rows after the fact?

 

[welshgasman]

Just discovered that the last row (6) which is for a different sheet has the correct values for the criteria as per the CF sheet?

 

[welshgasman]

No.
The sheet starts off with a set number of rows, which really depends on the previous month.
However if it was a quiet month then there might just be 30 rows.
Then the current month needs more rows, so I add 5 at a time with VBA.
That code is below.

Sub InsertRows()
'
' InsertRows Macro
'
Dim intActiveRow As Integer, intInsert As Integer, i As Integer, intCopyRow As Integer
intInsert = 5
intActiveRow = ActiveCell.Row
intCopyRow = ActiveCell.Row - 1

    Range("A" & intActiveRow & ":N" & intActiveRow).Select
    Selection.Copy
    For i = 1 To intInsert
        Selection.Insert Shift:=xlDown
        Rows(intActiveRow + i).RowHeight = 30
    Next
    intActiveRow = intActiveRow + intInsert

    ' Now copy the formulae
    Range("F" & intCopyRow).Copy
    Range("F" & intCopyRow + 1 & ":F" & intActiveRow).PasteSpecial , xlPasteSpecialOperationNone
    Range("H" & intCopyRow & ":N" & intCopyRow).Copy
    Range("H" & intCopyRow + 1 & ":N" & intActiveRow).PasteSpecial , xlPasteSpecialOperationNone
    Call SetPrintArea
End Sub

So if it works for you, then there must be something wrong with the actual sheet, as I have just noticed that the Passenger sheet had the CF as per the CF row for that sheet.

Thanks for testing that anyway.

 

[Joe4]

No.
The sheet starts off with a set number of rows, which really depends on the previous month.
However if it was a quiet month then there might just be 30 rows.
Then the current month needs more rows, so I add 5 at a time with VBA.
That code is below.

Sub InsertRows()
'
' InsertRows Macro
'
Dim intActiveRow As Integer, intInsert As Integer, i As Integer, intCopyRow As Integer
intInsert = 5
intActiveRow = ActiveCell.Row
intCopyRow = ActiveCell.Row - 1

    Range("A" & intActiveRow & ":N" & intActiveRow).Select
    Selection.Copy
    For i = 1 To intInsert
        Selection.Insert Shift:=xlDown
        Rows(intActiveRow + i).RowHeight = 30
    Next
    intActiveRow = intActiveRow + intInsert

    ' Now copy the formulae
    Range("F" & intCopyRow).Copy
    Range("F" & intCopyRow + 1 & ":F" & intActiveRow).PasteSpecial , xlPasteSpecialOperationNone
    Range("H" & intCopyRow & ":N" & intCopyRow).Copy
    Range("H" & intCopyRow + 1 & ":N" & intActiveRow).PasteSpecial , xlPasteSpecialOperationNone
    Call SetPrintArea
End Sub

So if it works for you, then there must be something wrong with the actual sheet, as I have just noticed that the Passenger sheet had the CF as per the CF row for that sheet.

Thanks for testing that anyway.

OK, so you hadn't included that "InsertRows" code in your initial post.
After you run that, I believe that you will need to run the "Set_CF" code again in order to reset everything properly.

Also note that if you have any "Worksheet_Change" or "Worksheet_Selection" event procedure code in any of these worksheets, that could be interfering with things too.

 

[welshgasman]

I have just copied the sheet in question and the CF to a new workbook with the code and now it starts at row 7, not 4 as in the code.
I will check those other events, but rarely use them TBH.

That is the whole point of this CF code to reset the entries to just what is in the CF sheet, as opposed to multiple CF entries for the same criteria, caused by copying the rows.