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