conditional formatting help

[fabiogiallo]

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]

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