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