VBA Code to Highlight Only Certain Instances within String

Question

I'm currently stuck with my VBA code to get the precise part of the string highlighted.

The ask: I need to identify within the string where TEMPO and TSRA are and change the font to bold red for everything in between them(including them as well).

The problem: There are many times where TEMPO can be included in the field, but I only want the TEMPO directly before an instance of TSRA, not the first instance of TEMPO through the entire message to the end of TSRA. For this problem I've tried using RegEx to identify but end up getting more than needed highlighted.

The secondary problem is that in some cases there can be multiple occurrences of TEMPO and TSRA in the same line and I need all of them also identified, not just the first instance of it. For this problem I have used position indicators to highlight, but only return the first instance of TEMPO to TSRA.

Below is an example of a string I'm testing: TAF USTR 191357Z 1915/2015 13005G13MPS 6000 FEW006 BKN020CB TEMPO1915/1918 VRB20MPS 0600 +TSRAGR SQ VV003 TEMPO 1918/200214003G11MPS 0200 TSRA FG VV002 FM200300 22005G12MPS 9999 BKN020CBTEMPO 2009/2015 24014MPS 3100 -TSRA

I tried using just position indicators in a loop with this code:

Sub HighlightTSRATerms()
    Dim targetRange As Range
    Dim cell As Range
    Dim cellText As String
    Dim startPos As Long
    Dim endPos As Long
    Dim highlightLength As Long
    Dim regEx As Object
    Dim match As Object
    Dim matches As Object
    Dim vctsPos As Long

    ' Set the target range
    Set targetRange = ActiveSheet.Range("N1:N100")
    
    ' Create RegExp object for ####/ pattern
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\b\d{4}/"
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.MultiLine = True
    
    

    ' Loop through each cell
    For Each cell In targetRange
        If Not IsEmpty(cell.Value) Then
            cellText = CStr(cell.Value)
            
            ' === Highlight "TEMPO" to "TSRA" ===
            startPos = InStr(1, cellText, "TEMPO", vbTextCompare)
            If startPos > 0 Then
                endPos = InStr(startPos + Len("TEMPO"), cellText, "TSRA", vbTextCompare)
                If endPos > 0 Then
                    highlightLength = (endPos + Len("TSRA")) - startPos
                    If startPos + highlightLength - 1 <= Len(cellText) Then
                        On Error Resume Next
                        With cell.Characters(Start:=startPos, Length:=highlightLength).Font
                            .Color = RGB(255, 0, 0)
                            .Bold = True
                        End With
                        On Error GoTo 0
                    End If
                End If
            End If
        End If
    Next cell
End Sub

This code only highlights the first instance of TEMPO to TSRA, not every occurrence Yellow highlighted needs to be included as well. (https://i.sstatic.net/fzGgmLM6.png)

Then I moved onto a RegEx method using this code:

Sub HighlightTSRATerms()
    Dim targetRange As Range
    Dim cell As Range
    Dim cellText As String
    Dim startPos As Long
    Dim endPos As Long
    Dim highlightLength As Long
    Dim regEx As Object
    Dim match As Object
    Dim matches As Object
    Dim vctsPos As Long

    ' Set the target range
    Set targetRange = ActiveSheet.Range("N1:N100")
    
    ' Create RegExp object for ####/ pattern
    Set regEx2 = CreateObject("VBScript.RegExp")
    regEx2.Pattern = "\b\d{4}/"
    regEx2.Global = True
    regEx2.IgnoreCase = True
    
    ' Create RegExp object for TEMPO through TSRA
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\b\TEMPO.*[^\n]\TSRA"
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.MultiLine = True

    ' Loop through each cell
    For Each cell In targetRange
        If Not IsEmpty(cell.Value) Then
            cellText = CStr(cell.Value)
            
            ' === Highlight "TEMPO" to "TSRA" ===
            If regEx.test(cellText) Then
                    Set matches = regEx.Execute(cellText)
                    For Each match In matches
                        If match.FirstIndex + match.Length <= Len(cellText) Then
                            On Error Resume Next
                            With cell.Characters(Start:=match.FirstIndex + 1, Length:=match.Length).Font
                                .Color = RGB(255, 0, 0)
                                .Bold = True
                            End With
                            On Error GoTo 0
                        End If
                    Next match
            End If
        End If
    Next cell
End Sub

This code highlights everything from the first instance of TEMPO to the last TSRA but includes everything, which includes text I don't want highlighted The yellow highlight here shows the parts of the string I don't want in red (https://i.sstatic.net/rUj285lk.png)

This is the expected output that I desire: (https://i.sstatic.net/itFdoZrj.png)

Any help if greatly appreciated!

Don't link to pictures when they contain text only. You can easily use formatting (bold and italics) to highlight text parts. And if at all: embed pictures. — AmigoJack
– AmigoJack, Commented Sep 16 at 21:15
This is pretty straightforward without regex. Find the start tag position then look for the first end tag after that - if the substring between those two doesn't contain the start tag, apply the formatting. Loop to find remaining start tags. — Tim Williams
– Tim Williams, Commented Sep 16 at 21:34
Not sure what you're asking so I can't post an answer. This is my best guess: TEMPO(?:(?:(?!TSRA).)*TSRA)?|TSRA regex101.com/r/sa5XL0/1 — sln
– sln, Commented Sep 17 at 18:19

taller · Accepted Answer · 2025-09-17 19:06:23Z

0

A quick fix for your script with RegExp.

*? → lazy quantifier, match as few as possible while still allowing the rest of the pattern to match
[^\n] should appear before *
\b should be removed

Sub HighlightTSRATerms()
    Dim targetRange As Range
    Dim cell As Range
    Dim cellText As String
    Dim startPos As Long
    Dim endPos As Long
    Dim highlightLength As Long
    Dim regEx As Object
    Dim match As Object
    Dim matches As Object
    Dim vctsPos As Long

    ' Set the target range
    Set targetRange = [a1:a2] ' ** for testing
    'Set targetRange = ActiveSheet.Range("N1:N100")
    targetRange.Font.Color = vbBlack ' reset font style
    targetRange.Font.Bold = False
    
    ' Create RegExp object for TEMPO through TSRA
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "TEMPO[^\n]*?TSRA" ' ** update RegExp pattern
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.Multiline = True

    ' ... your code

End Sub

Note: Wrap Text is enabled for column A.

edited Sep 17 at 19:06

answered Sep 17 at 18:14

taller

19.7k2 gold badges9 silver badges24 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

sln Sep 17 at 18:25

In the OPs highlighted picture TEMPO is matched next to a B.

taller Sep 17 at 19:05

Thanks. Good catch. I missed the last match in the picture. I'll update the code.

Tim Williams · Accepted Answer · 2025-09-17 17:05:55Z

This doesn't need regex. Find the start tag position then look for the first end tag after that - if the substring between those two doesn't contain the start tag, apply the formatting. Loop to find remaining start tags.

Sub Tester()

    Dim rng As Range, c As Range
    
    Set rng = ActiveSheet.Range("B3:B27")
    rng.Font.Color = vbBlack 'clear any existing highlights
    rng.Font.Bold = False
    
    For Each c In rng.Cells()
        HighlightBetween c, "TEMPO", "TSRA"
    Next c

End Sub

'Highlight any text in cell `c` which is between `vStart` and `vEnd`
Sub HighlightBetween(c As Range, vStart As String, vEnd As String)
    Dim txt As String, posS As Long, posE As Long
    
    txt = c.Value
    If Len(txt) = 0 Then Exit Sub
    
    posS = InStr(1, txt, vStart, vbTextCompare)
    Do While posS > 0
        posS = posS + Len(vStart) 'adjust start position
        
        posE = InStr(posS, txt, vEnd, vbTextCompare) 'next end tag
        If posE < 1 Then Exit Sub
       
        With c.Characters(Start:=posS, Length:=posE - posS)
            'set format only if substring doesn't contain `vStart`
            If InStr(1, .Text, vStart, vbTextCompare) < 1 Then
                Debug.Print "Highlighting: " & .Text
                .Font.Color = RGB(255, 0, 0)
                .Font.Bold = True
            End If
        End With
        
        posS = InStr(posS, txt, vStart, vbTextCompare) 'next start tag
    Loop
End Sub

Collectives™ on Stack Overflow

VBA Code to Highlight Only Certain Instances within String

2 Answers 2

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related