• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to apply multiple conditional formats to one column

Ruptrtt

New Member
Ive written some VBA code to apply Multiple conditional formats to one column, just to test that it worked I used Colours as the conditional format result to check that the Macro Works properly. However I really need it t apply Number formats as a result instead i.e " @" to the first " @" to the second and so on. And is .Select and Selection. really necessary , how can i reduce some code.

Code:
Sub Cond_Format3()
    Application.ScreenUpdating = False
    Cells.FormatConditions.Delete
    Range("B$8:$B$1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=1 "
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = vbBlue
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B$8:$B$1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=2 "
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = vbMagenta
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B$8:$B$1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ARABIC(MID(B8,FIND("")"",B8,1)+1,100))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = vbCyan
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B$8:$B$1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(FIND("")"",B8,1)=LEN(B8),ISTEXT(C8))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = vbYellow
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B$8:$B$1500").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(FIND("")"",B8,1)=LEN(B8),ISTEXT(C8),LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=1)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = vbGreen
        .TintAndShade = 0
    End With
    Application.ScreenUpdating = True
End Sub
 
There is nothing really wrong with what you have posted and if it works, great. But you are right that Select and Selection are not really necessary and better avoided if you can. Also some properties have default values and if you are not planning on changing them you don't need to list them out each time. Examples:
Code:
.PatternColorIndex = xlAutomatic
.TintAndShade = 0

An example of what it could look like w/o selects.
Code:
Sub Cond_Format3()
    Dim FormatRange As Range

    Set FormatRange = Range("B$8:$B$1500")            'set conditional format range
    FormatRange.FormatConditions.Delete               'clear any existing rules

    'Add and configure 1st rule
    With FormatRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=1 ")
        .SetFirstPriority
        .NumberFormat = "General"
        '.NumberFormat = "@"
        '.NumberFormat = "0.00"
        '.NumberFormat = "dd-mmm-yyyy"
        .Interior.Color = vbBlue
        .StopIfTrue = False
    End With

    'Add and configure 2nd rule
    With FormatRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=2 ")
        .SetFirstPriority
        .NumberFormat = "General"
        .Interior.Color = vbMagenta
        .StopIfTrue = False
    End With

    '3rd rule
    With FormatRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=ARABIC(MID(B8,FIND("")"",B8,1)+1,100))>0")
        .SetFirstPriority
        .NumberFormat = "General"
        .Interior.Color = vbCyan
        .StopIfTrue = False
    End With

    '4th
    With FormatRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(FIND("")"",B8,1)=LEN(B8),ISTEXT(C8))")
        .SetFirstPriority
        .NumberFormat = "General"
        .Interior.Color = vbYellow
        .StopIfTrue = False
    End With

    '5th
    With FormatRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(FIND("")"",B8,1)=LEN(B8),ISTEXT(C8),LEN(B8)-LEN(SUBSTITUTE(B8,""."",""""))=1)")
        .SetFirstPriority
        .NumberFormat = "General"
        .Interior.Color = vbGreen
        .StopIfTrue = False
    End With
End Sub

Also, you are using SetFirstPriority and StopIfTrue in every rule and that may not be necessary, but you would need to experiment to determine that.
 
No one asked me, but just for fun I'll chime here long enough to say that my own preference is always to spell out the property or method I'm using. It's not exactly that I don't trust the default property not to change—more that I don't trust my own memory. If I spell it out each time, I know what I'm getting. So when I'm copying a value from one cell to another, for example, I always always always say "<cell reference>.Value". That's a matter of coding style, of course.

I agree about using Selection. I set an object to the worksheet, cell or whatever and use it thereafter.
 
Back
Top