PDA

View Full Version : conditional formatting help



fabiogiallo
12-20-2019, 02:18 AM
Good morning,

i need to run the conditional formatting through VBA but i need some help to improve the code:
- i have a table of results, saved as record 1, 2, 3 (the real scenario will have thousands of records)
- i have the compliance limit (max, min) on top of the table. these limits are not static but dynamics (they could be all the time in different column, depending on the type of records) (see attached example)

I wrote a basic code, but i have limited knowledge about VBA and i was going to repeat this basic code for every column(not really working): i need the conditional formatting to be applied on every column where limits are shown (till the end of the column, related to number of records) and only for records with existing numbers (skip the empty cells).


Sub formatting()
Dim rng As Range
Dim condition1 As FormatCondition, condition2 As FormatCondition


Set rng = Range("B4", "B10000")


rng.FormatConditions.Delete


Set condition1 = rng.FormatConditions.Add(xlCellValue, xlGreater, ActiveSheet.Range("b1"))
Set condition2 = rng.FormatConditions.Add(xlCellValue, xlLess, ActiveSheet.Range("b2"))


'Defining and setting the format to be applied for each condition
With condition1
.Interior.Color = vbRed
End With


With condition2
.Interior.Color = vbRed


''''''and here i start again for anothe rcolumn and so on....

Dim rng2 As Range
Dim condition3 As FormatCondition, condition4 As FormatCondition
Set rng2 = Range("C4", "C10000")


rng2.FormatConditions.Delete


Set condition3 = rng2.FormatConditions.Add(xlCellValue, xlGreater, ActiveSheet.Range("c1"))
Set condition4 = rng2.FormatConditions.Add(xlCellValue, xlLess, ActiveSheet.Range("c2"))


With condition3
.Interior.Color = vbRed
End With


With condition3
.Interior.Color = vbRed
End With
End With
End Sub

thanks in advance!!

Artik
12-20-2019, 06:06 AM
Instead of formatting each column separately, you can apply one formula to conditional formatting.
The formula in conditional formatting must be given in the local language. The following code also solves this problem.

Sub Formatting_2()
Dim rng As Range


Set rng = Range("B4:AI10000")

rng.FormatConditions.Delete

rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
GetLocalFormula("=IF(AND(LEN(B$1)>0,LEN(B4)>0),OR(B4<B$1,B4>B$2))")
'Polish version "=JEŻELI(ORAZ(DŁ(B$1)>0;DŁ(B4)>0);LUB(B4<B$1;B4>B$2))"
rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority

With rng.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 14013951
.TintAndShade = 0
End With
rng.FormatConditions(1).StopIfTrue = False
End Sub




Function GetLocalFormula(strUSFormula As String) As String
Dim rngBlanks As Range
Dim rng As Range
Dim calcMode As XlCalculation
Dim eventMode As Boolean
Dim screenMode As Boolean


With ActiveSheet.UsedRange
On Error Resume Next
Set rngBlanks = .SpecialCells(xlCellTypeBlanks)
On Error GoTo 0




If Not rngBlanks Is Nothing Then
For Each rng In rngBlanks.Cells
If rng.NumberFormat <> "@" Then
Exit For
End If
Next rng


If rng Is Nothing Then
Set rng = .Offset(, .Columns.Count + 1)(1)
End If


With Application
screenMode = .ScreenUpdating
eventMode = .EnableEvents
calcMode = .Calculation


.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With


rng.Formula = strUSFormula


GetLocalFormula = rng.FormulaLocal


rng.ClearContents


With Application
.Calculation = calcMode
.EnableEvents = eventMode
.ScreenUpdating = screenMode
End With


Else
MsgBox "The active sheet is probably protected!" & vbLf & _
"I can't define a formula", vbCritical
End If

End With


End Function
Artik