This code will turn all double spaces (or more) into single spaces:
Code:
Sub find_space()
result = True
While result = True
On Error Resume Next
result = Cells.Find(What:=" ", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Err.Number = 91 Then Exit Sub 'didn't find double space(s)
If result = True Then
Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End If
Wend
End Sub