VBA, Conditinal Formatting & Named Range

[Jerseey]

Hi,
I was hoping someone could help me with the following issue:

I have an input file with conditional formatting helping me to verify input data. However, since people will be able to add lines in the input template, this conditional formatting will be split into many once people add new lines (common excel issue).

Therefore, I as planning to use a macro to help me delete and replace all current conditional formatting. However, the file is split into different sections, so I need to make it dynamic.

Snapshot from file below:

I've added the following formatting in Excel
Asset001Currency = AND($A$3<>"";$B3<>"";$D3="")
Asset002Currency = AND($A$7<>"";$B7<>"";$D7="")
Asset003Currency = AND($A$11<>"";$B11<>"";$D11="")

I've added the following named ranges:
Asset001Currency =$E$3:$E$5
Asset002Currency =$E$7:$E$9
Asset003Currency =$E$11:$E$13

However, adding this as a VBA will not help me when new lines are added, as the conditional formatting formulas are hardcoded and doesn't change when new row's are added, even though the named range changes.
Example:
A new WBS is added for Asset 002, changing the named range for Asset002Currency to Asset002Currency = $E$7:$E$10 and Asset003Currency = $E$12:$E$14. The conditional formatting for Asset002 will still work, but not conditional formatting for Asset 003.

Therefore, I created new named ranges to help:
Asset001Cell = $A$3
Asset002Cell = $A$7
Asset003Cell = $A$11

My plan was to then write a code that picks the row number of the AssetXXXCell and used it to make the conditional formatting dynamic

Sub ConditionalFormatting()
Row = Range(Asset002Cell).Row
Application.Goto Reference:="Asset002Currency"
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(Asset002Cell<>"""";$B&Row&<>"""";$D&Row&="""")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13408767
.TintAndShade = 0
End With

I would have to add this condition for all three assets.

However, my VBA code doesn't work. Can anyone help me?

 

[Alex Blakenburg]

It looks to me that your equation is just trying to decide if it is a WBS row and if so ensure that Currency is not left blank.
In that context does checking the Asset Header really add enough value to include it ?

If you leave that part of the equation, you could then use the same equation across the full data range considerably, significantly simplifying the issue.

eg Change
Asset001Currency = AND($A$3<>"";$B3<>"";$D3="")
to
Asset001Currency = AND($B3<>"";$D3="")
or if you need to tighten it up because you have text at total lines.
= AND(ISNUMBER($B3);$D3="")

 

[Jerseey]

Unfortunately, that won't work, as I need the conditional formatting to check if the AssetXXXCell is empty or not, it should only format the column if AssetXXXCell has been populated and the currency field is empty.

Also, to complicate further, I have an additional conditional formatting condition:
Asset001Currency = AND($A$3<>"";$B3<>"";$D3<>"";$D3<>"Asset001CurrencyOption")
Asset002Currency = AND($A$7<>"";$B7<>"";$D7<>"";$D7<>"Asset002CurrencyOption")
Asset003Currency = AND($A$11<>"";$B11<>"";$D11<>"";$D11<>"Asset003CurrencyOption")

Where AssetXXXCurrencyOption refrences to a named range of currency combinations unique for each of the assets.

 

[Alex Blakenburg]

Give the code below a go.
It relies on your statement that you will have:

• Range Names in column A using the format you specified
  • Asset001Cell = $A$3
  • Asset002Cell = $A$7|
  • Asset003Cell = $A$11
    ie Testing for --> Like "Asset*Cell"
• And Range Names for the Currency Lists in the format.
  • Asset001CurrencyOption
  • Asset002CurrencyOption
  • Asset003CurrencyOption
    ie replace(Asset001Cell,"Cell","CurrencyOption")

Sub ConditionalFormatting()

    Dim lastRow As Long
    Dim iRow As Long
    Dim sectFirstRow As Long
    Dim sectLastRow As Long
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim rng As Range
    Dim rngSectCurr As Range
    Dim rCell As Range
    Dim nm As String
    Dim nmNext As String
    
    Dim critAsset As String
    Dim critWBS1  As String
    Dim critWBS2  As String
    Dim critCurr As String
    Dim conditFnct As String
    
    Set wb = ActiveWorkbook
    Set sh = wb.ActiveSheet
    
    iRow = 3
    lastRow = sh.Range("B" & Rows.Count).End(xlUp).Row
    Set rng = sh.Range("A3:A" & lastRow)

    ' Loop through column A and find names ranges
    For Each rCell In rng
        nm = ""
        On Error Resume Next
        nm = rCell.Name.Name
        On Error GoTo 0
        
        If nm Like "Asset*Cell" Then
            sectFirstRow = rCell.Row
            iRow = sectFirstRow + 1
            ' find next Asset*Cell or lastRow
            
            nmNext = ""
            On Error Resume Next
            nm = sh.Cells(iRow, "A").Name.Name
            On Error GoTo 0
            Do While Not (nmNext Like "Asset*Cell") And iRow <= lastRow + 1
                iRow = iRow + 1
                On Error Resume Next
                nmNext = sh.Cells(iRow, "A").Name.Name
                On Error GoTo 0
            Loop
            sectLastRow = iRow - 1
            With sh
                Set rngSectCurr = .Range(.Cells(sectFirstRow + 1, "D"), .Cells(sectLastRow, "D"))
            End With
            
            critAsset = rCell.Address(True, True) & "<>" & """"""""""
            critWBS1 = rCell.Offset(1, 1).Address(False, True) & "<>" & """"""""""
            critWBS2 = "NOT(ISBLANK(" & rCell.Offset(1, 1).Address(False, True) & "))"
            ' replaced "," with ";"
            critCurr = "COUNTIFS(" & Replace(nm, "Cell", "CurrencyOption") & ";" & rCell.Offset(1, 3).Address(False, True) & ")=0"
            conditFnct = "=AND(" & critAsset & ";" & critWBS1 & ";" & critWBS2 & ";" & critCurr & ")"
                       
            With rngSectCurr
                .FormatConditions.Delete

                .FormatConditions.Add Type:=xlExpression, Formula1:=conditFnct
                    
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 13408767
                    .TintAndShade = 0
                End With
            End With
            
        End If

    Next rCell

End Sub

20210826 VBA Conditional Formatting.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1	Asset	WBS	Description	Currency	01-2021	02-2021
2
3	Asset 001								Asset001CurrencyOption	Asset002CurrencyOption	Asset003CurrencyOption
4	Asset 001	1010	XXX	USD	1000	100	50		USD	EUR	USD
5	Asset 001	1020	YYY		100	500	65		AUD	GBP	AUD
6
7	Asset 002
8	Asset 002	1210	XXX	EUR	1000	100	50
9	Asset 002	4200	YYY	ZZZ	100	500	65
10
11	Asset 003
12	Asset 003	4115	XXX		1000	100	50
13	Asset 003	4215	YYY	USD	100	500	65
14
Data

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D12:D14	Expression	=AND($A$11<>"""",$B12<>"""",NOT(ISBLANK($B12)),COUNTIFS(Asset003CurrencyOption,$D12)=0)	text	YES
D8:D10	Expression	=AND($A$7<>"""",$B8<>"""",NOT(ISBLANK($B8)),COUNTIFS(Asset002CurrencyOption,$D8)=0)	text	YES
D4:D6	Expression	=AND($A$3<>"""",$B4<>"""",NOT(ISBLANK($B4)),COUNTIFS(Asset001CurrencyOption,$D4)=0)	text	YES