Solved: Trimming multiple blanks

[Rejje]

Hi!

I notice below trim command does not remove trim multiple blanks within the text, only at beginning and end. The trim function in excel does this and I wonder if anyone can tell me how I get the same result using vba?

[VBA]
Public Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Not Application.Intersect(Target, Range("ALL_INPUT_DATA")) Is Nothing _
And Target.Count = 1 Then

Target = Trim(UCase(Target))
End If
Application.EnableEvents = True
End Sub
[/VBA]

[Simon Lloyd]

Something like this:
[vba]Public Sub Worksheet_Change(ByVal Target As Range)

Do
Target.Replace What:=" ", Replacement:=" ", LookAt:=xlPart
Loop Until Application.CountIf(Target, "* *") = 0
end sub
[/vba]

[Rejje]

Hmm, I get an everlasting loop by trying below. All cells I want to be trimmed are located in Range("TRIM_THESE").

[vba]
Public Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If (Not Intersect(Target, Range("TRIM_THESE")) Is Nothing) Then
Do
Target.Replace What:=" ", Replacement:=" ", LookAt:=xlPart
Loop Until Application.CountIf(Target, "* *") = 0
End If

Application.EnableEvents = True

End Sub
[/vba]

What's wrong?

[Simon Lloyd]

just do this then in a standard code module:
[VBA]Sub del_xtra_spaces()
Do
Range("TRIM_THESE").Replace What:=" ", Replacement:=" ", LookAt:=xlPart
Loop Until Application.CountIf(Range("TRIM_THESE"), "* *") = 0
end sub
[/VBA]

[Aussiebear]

Aren't you just replacing one blank for another blank? Try removing the space between the quotation marks in the Replacement :=" " section

[vba]Sub del_xtra_spaces()
Do Range("TRIM_THESE").Replace What:=" ", Replacement:="", LookAt:=xlPart
Loop Until Application.CountIf(Range("TRIM_THESE"), "* *") = 0
End Sub[/vba]

[Simon Lloyd]

I didn't test it to tell you the truth, however, if you do that Ted ALL the spaces will be removed i think?, i've not got excel here at the moment so can't test but will do in an hour or so.

[Paul_Hossler]

If you just want to call the worksheet version of Trim() ...

[vba]

Public Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Not Application.Intersect(Target, Range("ALL_INPUT_DATA")) Is Nothing _
And Target.Count = 1 Then
Target = Application.WorksheetFunction.Trim(UCase(Target))
End If

Application.EnableEvents = True

End Sub

[/vba]

Not tested

Paul

[Rejje]

If you just want to call the worksheet version of Trim() ...

[vba]

Public Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Not Application.Intersect(Target, Range("ALL_INPUT_DATA")) Is Nothing _
And Target.Count = 1 Then
Target = Application.WorksheetFunction.Trim(UCase(Target))
End If

Application.EnableEvents = True

End Sub

[/vba]

Not tested

Paul

Tested and works!

Thanks - I will go with this solution!

Rejje