VBA Excel substitute function for multiple conditions at once I use the SUBSTITUTE() function in my VBA code.
In Excel formula, we can nest it as shown in the thread below:
https://stackoverflow.com/questions/22313965/how-can-i-combine-multiple-nested-substitute-functions-in-excel/22314382
How can we do it in VBA Excel code?
How can I make my code smarter?
  For Each cell In rng
  cell = WorksheetFunction.Substitute(cell, &quot; &quot;, &quot;  &quot;, 25)
  cell = WorksheetFunction.Substitute(cell, &quot; &quot;, &quot;  &quot;, 24)
  cell = WorksheetFunction.Substitute(cell, &quot; &quot;, &quot;  &quot;, 23)
  Next
You do not want to read and write the cell multiple times. You only do a read and a write. You also need to check if the cell has a string. There is no point in running the replace on numbers or errors. Something like:
Dim v As Variant
Dim i As Long
Dim oldLen As Long

For Each cell In rng
    v = cell.Value2
    If VarType(v) = vbString Then
        oldLen = Len(v)
        For i = 25 To 23 Step -1
            v = WorksheetFunction.Substitute(v, &quot; &quot;, &quot;  &quot;, i)
        Next i
        If Len(v) &lt;&gt; oldLen Then cell.Value2 = v
    End If
Next

Or, if you want to be efficient then you read the range into array and replace the whole thing in one go:
Dim rngArea As Range
Dim arr() As Variant
Dim i As Long
Dim j As Long
Dim lastRow As Long
Dim hasChanged As Boolean
Dim v As Variant
Dim oldLen As Long

For Each rngArea In rng.Areas
    'Read range into array of values
    If rngArea.Count &gt; 1 Then
        arr = rngArea.Value2
    Else
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rngArea.Value2
    End If
    
    i = 1
    j = 1
    lastRow = UBound(arr, 1)
    hasChanged = False
    For Each v In arr 'Traverse the 2D array column-wise
        If VarType(v) = vbString Then
            oldLen = Len(v)
            For i = 25 To 23 Step -1
                v = WorksheetFunction.Substitute(v, &quot; &quot;, &quot;  &quot;, i)
            Next i
            If Len(v) &lt;&gt; oldLen Then
                arr(i, j) = v
                hasChanged = True
            End If
        End If
        i = i + 1
        If i &gt; lastRow Then
            i = 1
            j = j + 1
        End If
    Next v
    If hasChanged Then
        rngArea.Value2 = arr
    End If
Next rngArea