Delete Any Space Found At End Of Range

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.

Code:

---

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!

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.

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.

For example:

Code:

---

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

---

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 :-

Code:

---

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

---

For example:

Code:

---

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

---

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