Excel VBA using RegEx for Conditional Formating

Question

I have an Excel 2010 VBA macro that does some conditional formatting over a select area of a spreadsheet. As an example the following snippet searches for a text pattern then colors the cell:

Selection.FormatConditions.Add Type:=xlTextString, String:="TextToMatch", _
    TextOperator:=xlContains    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ColorIndex = 36
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False 

What I would like to add is to match against a regular expression TN[0-9]. A simple match of the string TN followed by a digit.

I have created the RegExp obect:

Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
With regEx
        .Pattern = "TN[0-9]"
End With

However I have not figured out how to apply this to the Selection.

As always, thank you for your assistance.

Answer 1

I would recommend using a Static type object for your VBScript.RegExp object.

Cut the range passed into the function down to the Worksheet.UsedRange property. This allows a selection of full columns without calculating empty rows/columns.

Option Explicit

Sub createCFR()
    With Selection
        'cut Selection down to the .UsedRange so that full row or full
        'column references do not use undue calculation
        With Intersect(.Cells, .Cells.Parent.UsedRange)
            .FormatConditions.Delete
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=myCFR(" & .Cells(1).Address(0, 0) & ")")
                .SetFirstPriority
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 36
                    .TintAndShade = 0
                End With
                .StopIfTrue = False
            End With
        End With
    End With
End Sub

Function myCFR(rng As Range)
    Static rgx As Object

    'with rgx as static, it only has to be created once
    'this is beneficial when filling a long column with this UDF
    If rgx Is Nothing Then
        Set rgx = CreateObject("VBScript.RegExp")
    End If

    'make sure rng is a single cell
    Set rng = rng.Cells(1, 1)

    With rgx
        .Global = True
        .MultiLine = True
        .Pattern = "TN[0-9]"
        myCFR = .Test(rng.Value2)
    End With
End Function

Depending on your Selection, you may need to modify the parameters of the Range.Address property used to create the CFR; e.g. $A1 would be .Address(1, 0).

In the following image, B2:B7 contain =myCFR(A2) filled down to proof the UDF.