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?


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

[Simon Lloyd]

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

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

[Rejje]

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


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


What's wrong?

[Simon Lloyd]

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

[Aussiebear]

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

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

[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() ...



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


Not tested

Paul

[Rejje]

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



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


Not tested

Paul

Tested and works!

Thanks - I will go with this solution!

Rejje