VBA to apply multiple conditional formats to one column

[Ruptrtt]

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.

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

 

[rlv01]

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:

.PatternColorIndex = xlAutomatic
.TintAndShade = 0

An example of what it could look like w/o selects.

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.