Sub Set_ConditionalFormatting()
'
'
Sort_ConditionalFormatting
'On Error GoTo ErrorMessage
'Define Range
Dim MyRange As Range
'Delete Existing Conditional Formatting from entire sheet
Debug.Print "---------------------- START -----------------------------"
Debug.Print "Clearing any existing conditional formatting on this sheet"
Sheets("Conditional Formatting").Cells.FormatConditions.Delete
Dim rng As Range 'Range in which the conditions are defined
Dim cell As Range 'for each line in the conditions table
'Posstible conditions
Dim Cond_Underline
Dim Cond_Bold
Dim Cond_Color
Dim Cond_Italic
Dim SetUnderline
' Walk through conditions table
Debug.Print "Setting the conditions by going through the table"
Set rng = Sheets("Conditional Formatting").Range("tbl_CondFormatting[Order]")
For Each cell In rng
RuleId = cell.Value2
Debug.Print "- Setting rule " & RuleId
Rule = cell.Offset(0, 1).Value2
Applies_To = cell.Offset(0, 2).Value2
Cond_Bold = cell.Offset(0, 3).Value2
Cond_Italic = cell.Offset(0, 4).Value2
Cond_Underline = cell.Offset(0, 5).Value
Cond_Color = cell.Offset(0, 6).Value2
'Translate underline value into Excel property
Select Case Cond_Underline ' Evaluate Cond_Underline
Case "None" ' .
'Debug.Print "None"
SetUnderline = xlUnderlineStyleNone
Case "Single" '
'Debug.Print "Single"
SetUnderline = xlUnderlineStyleSingle
Case "Double" '
'Debug.Print "Double"
SetUnderline = xlUnderlineStyleDouble
Case Else ' Other values.
Debug.Print "Not sure what kind of underline is needed"
SetUnderline = xlUnderlineStyleNone
End Select
'Apply Conditional Formatting
'-------------
' Define the Applies To field in the Conditional Formatting Rules Manager
Set MyRange = Range(Applies_To)
' Define the Rule field in the Conditional Formatting Rules Manager
MyRange.FormatConditions.Add Type:=xlExpression, Formula1:=Rule
' Define the formatting of the cell
With MyRange.FormatConditions(MyRange.FormatConditions.Count).Font
.Bold = Cond_Bold
.Underline = SetUnderline
.ColorIndex = Cond_Color
.Italic = Cond_Italic
End With
MyRange.FormatConditions(MyRange.FormatConditions.Count).StopIfTrue = False
Next cell
Debug.Print "---------------------- END -------------------------------"
Exit Sub
ErrorMessage:
Err.Number = vbObjectError + 1052
Debug.Print "ERROR while setting rule "; RuleId
Debug.Print "Error: " & Err.Number & Chr(10) & "Description: " & Err.Description
Debug.Print "----------------------------------------------------------"
End Sub
Sub Sort_ConditionalFormatting()
'
' Sorting the table to add the rules in the defined order
'
ActiveWorkbook.Worksheets("Conditional Formatting").ListObjects( _
"tbl_CondFormatting").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Conditional Formatting").ListObjects( _
"tbl_CondFormatting").Sort.SortFields.Add2 Key:=Range( _
"tbl_CondFormatting[[#All],[Order]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Conditional Formatting").ListObjects( _
"tbl_CondFormatting").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
