Auto Highlight Macro

Closed
Kevin - Mar 15, 2016 at 12:40 AM
This is my autohighlight macro using conditional formatting, these are my problems that I need to solve:

Items Done

Highlight Yellow - Sat and Sun and Warning Rows - ok
Highlight Purple - Negative Values - ok


Needs to Solve :

Highlight Blue - if Column H has a 0 value, highlight entire row blue
Highlight Orange - if Column G has a 1 value, highlight entire row orange
Highlight Red - Blank Cells and don't highlight blank rows

Formula : If a Cell indicated False highlight the cell beneath :

o Positive (+) value - high sales – yellow
o Negative (-) vAlue - low sales - blue





Sub HighlightAll1_4()

'Error Handler

On Error GoTo Terminate

'Execute Highlight on Specific Sheets

sheetlist = Array("M1_API", "M1_Direct", "M1_Symbion", "M1_Sigma", "M1_WS", "M3_API", "M3_Direct", "M3_Symbion", "M3_Sigma", "M3_WS")
For i = LBound(sheetlist) To UBound(sheetlist)
Worksheets(sheetlist(i)).Activate

'Range where to apply conditional formatting

lastCol = ActiveSheet.Range("A1").End(xlToRight).Column
lastRow = ActiveSheet.Range("A1000").End(xlUp).Row
ActiveSheet.Range("A1", ActiveSheet.Cells(lastRow, lastCol)).Select

'Apply Red Color on blanks

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEN(TRIM(A1))=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

'Apply Yellow Color on Sat

Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SEARCH(""Sat"",$C1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With

'Apply Yellow Color on Sun

Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SEARCH(""Sun"",$C1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With

'Apply Yellow Color on Warning

Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SEARCH(""warning"",$A1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

' Highlight Negative Values with Purple

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=-0.01", Formula2:="=-999999999"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13418714
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True

'MsgBox "Highlight Done!" & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "By: Kevin Borlasa"
CheckBlanks
HighlightRed
Next
Exit Sub
Terminate:
MsgBox "You've click the wrong Highlight Macro!"
End
End Sub

Sub HighlightRed()

'Error Handler

On Error GoTo Terminate

'Execute Highlight on Specific Sheets

sheetlist = Array("M2_API", "M2_Direct", "M2_Symbion", "M2_Sigma", "M2_WS", "M4_API", "M4_Direct", "M4_Symbion", "M4_Sigma", "M4_WS")
For i = LBound(sheetlist) To UBound(sheetlist)
Worksheets(sheetlist(i)).Activate

'Range where to apply conditional formatting

lastCol = ActiveSheet.Range("A1").End(xlToRight).Column
lastRow = ActiveSheet.Range("A1000").End(xlUp).Row
ActiveSheet.Range("A1", ActiveSheet.Cells(lastRow, lastCol)).Select

'Apply Red Color on blanks

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEN(TRIM(A1))=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Next
Exit Sub
Terminate:
MsgBox "You've click the wrong Highlight Macro!"
End
End Sub

Sub CheckBlanks()

'Declare Variable

Dim r_range As Long
r_range = Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
'blank_range = Application.WoksheetFunction.CountB(ActiveSheet.Range("A:A"))

'Loop (Count blanks) and data only

For counter = 1 To r_range
If ActiveSheet.Range("A" & counter) = "" Then
If ActiveSheet.Range("B" & counter) = "" Then
ActiveSheet.Rows(counter & ":" & counter).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=SEARCH(""%"",$A1)"
Selection.FormatConditions.Delete
End If
End If
Next counter
ActiveSheet.Range("A1").Select

End Sub