VBA, Conditinal Formatting & Named Range

Jerseey

New Member
Joined
Apr 20, 2021
Messages
8
Office Version
  1. 365
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:

VBA, Conditional Formatting & Named Range.png


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?
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
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="")
 
Upvote 0
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.
 
Upvote 0
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")
VBA Code:
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
ABCDEFGHIJKL
1AssetWBSDescriptionCurrency01-202102-2021
2
3Asset 001Asset001CurrencyOptionAsset002CurrencyOptionAsset003CurrencyOption
4Asset 0011010XXXUSD100010050USDEURUSD
5Asset 0011020YYY10050065AUDGBPAUD
6
7Asset 002
8Asset 0021210XXXEUR100010050
9Asset 0024200YYYZZZ10050065
10
11Asset 003
12Asset 0034115XXX100010050
13Asset 0034215YYYUSD10050065
14
Data
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D12:D14Expression=AND($A$11<>"""",$B12<>"""",NOT(ISBLANK($B12)),COUNTIFS(Asset003CurrencyOption,$D12)=0)textYES
D8:D10Expression=AND($A$7<>"""",$B8<>"""",NOT(ISBLANK($B8)),COUNTIFS(Asset002CurrencyOption,$D8)=0)textYES
D4:D6Expression=AND($A$3<>"""",$B4<>"""",NOT(ISBLANK($B4)),COUNTIFS(Asset001CurrencyOption,$D4)=0)textYES
 
Upvote 0

Forum statistics

Threads
1,223,977
Messages
6,175,753
Members
452,667
Latest member
vanessavalentino83

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