PDA

View Full Version : VBA unable to set CF for second range



willara23
06-30-2016, 05:36 PM
Excel 2010 version: 14.0.7015.1000(32-Bit)

I have referred to detail offered at 'https://msdn.microsoft.com/en-us/lib...ice.12%29.aspx'

The code works as I hoped for the range "N2:N300", though I can only implement one condition successfully for the next range "O2:O300". If I attempt to implement both conditions on the range O2:O300, one format appears to be assigned to the other condition, while the other format is not applied.

Initially I thought I had not applied mutually exclusive logic in the formula. I believe I have the mutual exclusivity correct, which I verified on sheet "Test mutual exclusivity".

Clearly there is an error and or a lack of understadning on my part. I have attempted to solve the issue over days of this week, and searched various web resources with out success.

I would appreciate any guidance in resolving issue, or if not possible at least understand the limitation related to the expectation.


Sub CFR()
On Error Resume Next
Dim Sht As Worksheet: Set Sht = Sheets("R")
Application.EnableEvents = False
Application.ScreenUpdating = False

With Sht
.Activate
With .Range("N2:N300") 'Red for MCED <=5 days to expire
.Activate
'set cell to red when the DOI field isblank
'IF(AND(OR(D15="p",D15="w"),OR(ISBLANK(E14),E15="opt")),TRUE,FALSE)
'.FormatConditions.Delete
'.FormatConditions.Add xlExpression, Formula1:="IF(AND(OR(J2=""p"",J2=""w""),OR(ISBLANK(N2),N2=""opt"")),TRUE,FALSE)"
'.FormatConditions(1).Priority = 1
'.FormatConditions(1).Interior.ColorIndex = 3
'.FormatConditions(1).Font.ColorIndex = 1

'set cell to no colour when the days difference between the DOI and today is <90
'.FormatConditions.Delete
'.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w""),(NOW()-N2)<90),TRUE,FALSE)"
'.FormatConditions(1).Priority = 2
'.FormatConditions(1).Interior.ColorIndex = 2
'.FormatConditions(1).Font.ColorIndex = 1

'set cell to red when the days difference between the DOI and today is >=90 and <180
.FormatConditions.Delete
.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),AND((TODAY()-N2)>=90,(TODAY()-N2)<180)),TRUE,FALSE)"
.FormatConditions(1).Priority = 1
.FormatConditions(1).Interior.ColorIndex = 6
.FormatConditions(1).Font.ColorIndex = 1

'set cell to red when the days difference between the DOI and today is >=180 and <365
.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),AND((TODAY()-N2)>=180,(TODAY()-N2)<365)),TRUE,FALSE)"
.FormatConditions(1).Priority = 2
.FormatConditions(2).Interior.ColorIndex = 44
.FormatConditions(2).Font.ColorIndex = 1

'set cell to red when the days difference between the DOI and today is >=365
.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(TODAY()-N2)>=365),TRUE,FALSE)"
.FormatConditions(1).Priority = 3
.FormatConditions(3).Interior.ColorIndex = 3
.FormatConditions(3).Font.ColorIndex = 2
End With

With .Range("O2:O300") 'Case age from DOI Red >=365 days, 365>Amber>=120, 120>Yellow>=90
.Activate
.FormatConditions.Delete

.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),AND((O2-INT(TODAY()))<=5,(O2-INT(TODAY()))>=0)),TRUE,FALSE)"
.FormatConditions(1).Priority = 1
.FormatConditions(1).Interior.ColorIndex = 44
.FormatConditions(1).Font.ColorIndex = 1

.FormatConditions.Add xlExpression, Formula1:="=IF(AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(O2-INT(TODAY()))<0),TRUE,FALSE)"
.FormatConditions(1).Priority = 2
.FormatConditions(1).Interior.ColorIndex = 3
.FormatConditions(1).Font.ColorIndex = 2
End With
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

p45cal
07-01-2016, 10:47 AM
I have referred to detail offered at 'https://msdn.microsoft.com/en-us/lib...ice.12%29.aspx'This link doesn't work because it's shortened with the ... . While I appreciate you can't post real links until your post count is up and need to post the url from the address field rather than from another link - if you miss off the http part people will be able to find the link.



The code works as I hoped for the range "N2:N300", though I can only implement one condition successfully for the next range "O2:O300". If I attempt to implement both conditions on the range O2:O300, one format appears to be assigned to the other condition, while the other format is not applied.
1. The code doesn't seem to give any format at all to the second condition in column O (probably to do with the numbers in parentheses after .FormatConditions - which might also go some way to explaining why "one format appears to be assigned to the other condition". Record a macro of you applying the CF to column O).
2. Although you say the CF in column N works as you'd hoped, you don't say how you hope the CF to work in column O; the code comments only talk of a difference, but no direction of difference.
My first doubts are the reversal of these elements in the formulae, comparing column N with column O:
Column N:
(TODAY()-N2)

Column O:
O2-INT(TODAY())

I don't know if that's intentional.
A few other asides:
You don't need to take the Integer of Today(), it's already a whole number.
You don't need to encase the condition in
IF(condition,TRUE,FALSE)
It's simpler just to have:
condition

So
=IF(AND(OR(J2="p",J2="w",J2="r",J2="n"),AND((O2-INT(TODAY()))<=5,(O2-INT(TODAY()))>=0)),TRUE,FALSE)
could just be:
=AND(OR(J2="p",J2="w",J2="r",J2="n"),AND((O2-INT(TODAY()))<=5,(O2-INT(TODAY()))>=0))
or
=AND(OR(J2="p",J2="w",J2="r",J2="n"),AND((O2-TODAY())<=5,(O2-TODAY())>=0))
or even:
=AND(OR(J2="p",J2="w",J2="r",J2="n"),O2-TODAY()<=5,O2-TODAY()>=0)
which makes it a lot easier to fathom.

Now… should that last be:
=AND(OR(J2="p",J2="w",J2="r",J2="n"),TODAY()-O2<=5,TODAY()-O2>=0)

willara23
07-04-2016, 06:04 PM
Thanks. I am working with your advice now and will respond.

willara23
07-04-2016, 09:07 PM
Thank you. Your advice was of help. I think the most significant help was with regard to running the macro recorder. The link being incomplete was an oversight. I did modify the conditions as you discussed, for the sake of simplification. The INT(TODAY()) was laziness on my part at the time, and the order of "O2-TODAY()" is intentional.

The corrected code follows and works as required. Thank you.


Sub CFR()
'On Error Resume Next
Dim Sht As Worksheet: Set Sht = Sheets("R")
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sht
.Activate
'***** Case age from DOI Red >=365 days, 365>Amber>=120, 120>Yellow>=90 *****
With .Range("N2:N300")
.Activate
Selection.FormatConditions.Delete
'///// set cell to yellow when the days difference between the DOI and today is >=90 and <180
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(TODAY()-N2)>=90,(TODAY()-N2)<180)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'///// set cell to orange when the days difference between the DOI and today is >=180 and <365
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(TODAY()-N2)>=180,(TODAY()-N2)<365)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'///// set cell to red when the days difference between the DOI and today is >=365
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(TODAY()-N2)>=365)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End With

'***** Red for MCED <=5 days before expiry, and orange for cases which have expired *****
With .Range("O2:O300")
.Activate
.FormatConditions.Delete
'///// set cell to red when the date has 5 remaining before expiry
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),(O2-TODAY())<=5,(O2-TODAY())>=0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'///// set cell to orange when the date has older than today
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(OR(J2=""p"",J2=""w"",J2=""r"",J2=""n""),O2-TODAY()<0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End With
.Range("O2").Select
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

snb
07-05-2016, 12:47 AM
After that you might improve the code; e.g.


Sub M_snb()
With Sheet1.Range("N2:N300").FormatConditions
.Delete
For j = 1 To 3
.Add(2, , "=not(iserror(search(J2,""pwrn"")))*(N2<>"""")*((today()-N2)" & Choose(j, ">365", ">180", ">90") & ")").Interior.Color = Choose(j, 255, 49407, 65535)
Next
End With
End Sub

willara23
07-07-2016, 09:14 PM
Oh yes. I would not have gone on to that myself. Thank you I will try it.