kevinborlasa
03-14-2016, 11:04 PM
This is my autohighlight macro using conditional formatting, I used record macro because I'm just a beginner, 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 :
For Macros 1 - 4 file:
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
For Macros 5-7 file:
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
Here's my code :
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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
Items Done :
Highlight Yellow - Sat and Sun and Warning Rows - ok
Highlight Purple - Negative Values - ok
Needs to Solve :
For Macros 1 - 4 file:
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
For Macros 5-7 file:
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
Here's my code :
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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).SetFirstPriori ty
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