Hi all,

I'm having a problem removing leading and lagging spaces from cells in a
column of data (FYI - the data was input from an Excel spreadsheet that was
dowloaded from a website). I looked through some other postings and found
the "Trimall" macro -- I've tried this but it is still not removing the
spaces. Below is the Trimall macro with two lines that I added (to select
all cells in Sheet1) noted with **. Column AD specifically has the data that
I am trying to remove the spaces from.

I appreciate your help!

Sub TrimALL()

**Sheets("Sheet1").Select
**Cells.Select
'David McRitchie 2000-07-03 mod 2002-08-16 2005-09-29 join.htm
'-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
' - Optionally reenable improperly terminated Change Event macros
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=Chr(13) & Chr(10), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=Chr(13), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=Chr(21), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'---------------------------
Selection.Replace What:=Chr(8), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=Chr(9), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

--
Robert