Try this
Sub TrimEText()
' This module will trim extra spaces from BOTH SIDES and excessive spaces from inside the text.
Dim MyCell As Range
Dim lrow As Long
lrow = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For Each MyCell In Range("A2:P" & lrow).SpecialCells(xlCellTypeConstants, 23).Cells
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
Next
On Error GoTo 0
End Sub
Bookmarks