Delete Any Space Found At End Of Range

[HTSCF Fareha]

I'm really struggling to try and get a sub to delete any trailing space that it finds within a content control range. I've looked across the internet and can find plenty to help trim trailing spaces within a cell for Excel, but nothing for Word (or at least I cannot find anything).

This sub will need to work within a UserForm / Macro Enabled Template environment.

There is only usually a single space that needs deleting (occasionally two), but this sub will be called to run across numerous Content Controls.

I'm not sure whether it would be prudent to try and cover all the various different forms of space, such as non breaking etc.

Here is what I have at the moment.


Private Sub DeleteTrailingSpace(cCtrl As ContentControl)

Dim oRng As Range

With cCtrl.Range

Set oRng = cCtrl.Range

' If the last character is a space then delete it
If oRng.Characters.Last = Chr(32) Then
oRng.Characters.Last.Delete
ElseIf oRng.Characters.Last <> Chr(32) Then

End If
End With

lbl_Exit:
Exit Sub

Hoping someone can help. Thanks!

[lexidiaz724]

Removing redundant spaces in the middle, beginning and end of the line, special characters in MS Word. While changing the font throughout the document is not a problem, it is not so easy with redundant characters. An obvious solution to remove double spaces suggests itself at once - it is to call the symbol substitution window: the "Main" tab, the "Edit" group or key combination Ctrl+H and replace 2 spaces with one. You have to repeat the operation several times and it will not take much time. The next character to be deleted is the line feed character. To delete it, use the Find & Replace command again, but as a replacement character, select "Line Break".
It remains only to remove spaces at the beginning of lines and before the paragraph break character, as simple as done in the beginning, they can not be removed, because in this case will be removed and the entire document. However, there is a way out, just call the search and replace window again and replace ^p^w with ^p, so it will remove spaces at the beginning of lines, and to remove spaces before the paragraph break sign, then just replace ^w^p with ^p.

[HTSCF Fareha]

Thank you for your reply, however this is not a practicle solution for me.

I was already aware of the search / replace within word itself and this is just not viable. I will need a macro to do this automatically.

[macropod]

For example:

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl
For Each CCtrl In ActiveDocument.ContentControls
With CCtrl
Select Case .Type
Case wdContentControlComboBox, wdContentControlText, wdContentControlRichText
Do While .Range.Characters.Last = " "
.Range.Characters.Last.Text = vbNullString
Loop
Case Else
End Select
End With
Next
Application.ScreenUpdating = True
End Sub

[HTSCF Fareha]

Thank you Paul, this provided me with a way of putting in place a couple of minor tweaks to fit. It does indeed remove the pesky extra spaces.

The only issue that I have is that further up the sub, which I am using to ensure that only single spaces are used between words, after commas and question marks, it will still leave the space. If I comment out the find / replace for full stops, it removes the space. I'm really not sure what to do to make all this work. I appreciate that this has moved the original query of my post, but I really didn't think that it would affect things as it has.

Here is my full sub, with commented out part for placing single space after any full stop :-


Private Sub FixSpacing(CCtrl As ContentControl)

Dim oRng As Range

With CCtrl.Range

' Put single space after full stop
'With .Find
' .ClearFormatting
' .Replacement.ClearFormatting
' .Text = "."
' .Replacement.Text = ". "
' .Forward = True
' .Format = False
' .Wrap = wdFindContinue
' .MatchWildcards = True
' .Execute Replace:=wdReplaceAll
' End With

' Put single space after comma
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = ", "
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

' Put single space after question mark
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[\?]"
.Replacement.Text = "? "
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

' Remove extra blank spaces
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([^s ])@[^s ]"
.Replacement.Text = " "
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

' Remove trailing spaces
With CCtrl
Select Case .Type
Case wdContentControlText, wdContentControlRichText
Do While .Range.Characters.Last = " "
.Range.Characters.Last.Text = vbNullString
Loop
Case Else
End Select
End With

End With

lbl_Exit:
Exit Sub
End Sub

[macropod]

For example:

Private Sub FixSpacing(CCtrl As ContentControl)
Dim Rng As Range
With CCtrl
Select Case .Type
Case wdContentControlText, wdContentControlRichText
Set Rng = .Range
With Rng
' Remove trailing spaces
Do While .Characters.Last = " "
.Characters.Last.Text = vbNullString
Loop
.End = .End - 1
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
' Put single space after full stop
.Text = "."
.Replacement.Text = ". "
.Execute Replace:=wdReplaceAll
' Put single space after comma
.Text = ","
.Replacement.Text = ", "
.Execute Replace:=wdReplaceAll
' Put single space after question mark
.Text = "[\?]"
.Replacement.Text = "? "
.Execute Replace:=wdReplaceAll
' Remove extra spaces
.Text = "([^s ])@[^s ]"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With
End With
Case Else
End Select
End With
End Sub

[HTSCF Fareha]

My sincere thanks to you Paul!

It never ceases to amaze me that a slightly different approach solves the issue. I never thought that placing the find / replace within the Select Case would make such a difference. As another bonus, this seems to run a lot quicker. :thumb