VBA Excel substitute function for multiple conditions at once

Question

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, " ", "  ", 25)
  cell = WorksheetFunction.Substitute(cell, " ", "  ", 24)
  cell = WorksheetFunction.Substitute(cell, " ", "  ", 23)
  Next

Answer 1

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, " ", "  ", i)
        Next i
        If Len(v) <> 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 > 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, " ", "  ", i)
            Next i
            If Len(v) <> oldLen Then
                arr(i, j) = v
                hasChanged = True
            End If
        End If
        i = i + 1
        If i > lastRow Then
            i = 1
            j = j + 1
        End If
    Next v
    If hasChanged Then
        rngArea.Value2 = arr
    End If
Next rngArea