Conditional formatting not working on percentages??

[Rel3ntless]

Hi Guys,


I'm trying to apply conditional formatting on a script I've recorded for data exported from another program. So the conditional formatting I'm trying to apply is to color values between 70%-89% yellow and 90%-100% red. When applying these conditions the entire row is highlighted red. I then later discovered that it the conditions worked properly when the percentage signs were removed.


I then tried applying % format to these cells but got the error "style percentage not found". Apparently to fix this remedy involved merging the sheet with one that had the percentage style present but this isn't something I'd want to do everytime I export the data from the other program.


Is there a way around this? An alternative I was thinking was to program it to manually input the percentage signs back in after for cells between B2:I2 - can someone help me create the code for this and post? I'll also need the cell directly below to be coloured the same condition as above. ie: if 75%, color cell yellow along with the cell directly below.

So far I my script has been able to give me the following results:

https://drive.google.com/file/d/1Jsf-tWmCsXy0L-FbOrKy_5IslwdSiIIC/view?usp=sharing

What I'm trying to achieve:

https://drive.google.com/file/d/1bHUdG5ufqkqzp1ubHGfmWmSyiQjb0mP_/view?usp=sharing


here's my script code:

Sub TrafficMacro()
'
' TrafficMacro Macro
'


'
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A4").Select
    Selection.Cut Destination:=Range("B4")
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("2:2,5:5,6:6,4:4,3:3").Select
    Range("A3").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Traffic Avails Week Starting"
    Range("A1:J3").Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("B2:I2").Select
    Cells.Replace What:="%", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Sellout%"
        Range("B2:I2").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="=70", Formula2:="=89"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        End With
        Range("B2:I2").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="=90"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    Range("H5").Select
    End With
    Range("A1:J3").Select
    Selection.Copy
End Sub

Any help would be greatly appreciated!

 

[Joe4]

If I try to run your current code on the original data file, it deletes all the data.

 

[Rel3ntless]

doh sorry for my delayed response. Was sick as a dog over the weekend.

I've re-uploaded the file on google drive, please try this link: https://drive.google.com/open?id=13V707sX5CtinXpFbQu5zop7I9LNKspII

 

[Joe4]

That is just your VBA code, not your data file.

 

[Rel3ntless]

My mistake, I misunderstood what you needed. Try this: https://drive.google.com/open?id=1PYVPZoBc26TFEamiq8ugZOJNBGYNjnW4

 

[Joe4]

Try this:

Sub TrafficClassicalMacro()
'
' TrafficClassicalMacro Macro
'
'
    Range("B1").FormulaR1C1 = "Classical Traffic Avails Week Starting"
    Range("C1").FormulaR1C1 = "11/27/17 Traffic Spon M-F 5a-7p"
    Range("C1:J1").Replace What:=" Traffic Spon M-F 5a-7p", Replacement:="", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:G").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Rows("2:27").Delete Shift:=xlUp
    Range( _
        "3:9,11:11,12:12,13:13,14:14,15:15,16:16,17:17,18:18,19:19,20:20,21:21,22:22,23:23,24:24" _
        ).Select
    Range("A24").Activate
    Selection.Delete Shift:=xlUp
    Range("A2:A3").Cut Destination:=Range("B2:B3")
    Columns("A:A").Delete Shift:=xlToLeft
    
    Range("A1:J3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        Columns("A:J").EntireColumn.AutoFit
    End With
    
    Range("Z1").FormulaR1C1 = "100"
    Range("Z1").Copy
    Range("B2:I2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0%"
    
    Range("B2:I3").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(VALUE(B$2)>=70%,VALUE(B$2)<=89%)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(VALUE(B$2)>=90%,VALUE(B$2)<=100%)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    
    Range("Z1").ClearContents
    
    Range("A1:J3").Copy
End Sub

 

[Rel3ntless]

YES!! Thank you again so much, this is perfect!! Happy HolidayS

 

[Joe4]

You are welcome.