Page 1 of 2 12 LastLast
Results 1 to 15 of 24
  1. #1
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts

    Problem with spaces after abbreviations in Word 2010

    Hi, I am having problems with the macro below in that it is putting two spaces after abbreviations when I only need one space. I have spent hours on this today and can't get it to work properly no matter what I do. In the coding below, i.e. and e.g. and etc. only need one space after them. Somewhere in the coding it does have a command to put two spaces after a period but only for sentences. It is supposed to convert i.e.[space][space] back to i.e.[space]. Any help would be greatly appreciated. Regards, Shelley

    Code:
    Sub DPU_HouseStyleFormatCleanUp()
    Application.ScreenUpdating = False
    Dim Fld As Field, Rng As Range, i As Long, ArrFnd
    ArrFnd = Array("[Mm]inute", "[Hh]our", "[Dd]ay", "[Ww]eek", "[Mm]onth", "[Yy]ear", "[Ww]orking", "[Bb]usiness", "Act")
    With ActiveDocument
      'ensure spaces after cross-references are non-breaking
      For Each Fld In .Fields
        If Fld.Type = wdFieldRef Then
          Set Rng = Fld.Result.Previous.Characters(1)
          Rng.Text = Replace(Rng.Text, " ", Chr(160))
        End If
      Next
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        'Ensure spaces within dates are non-breaking
        .Text = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
        .Replacement.Text = "\1^s\2^s\3"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers are non-breaking
        .Text = " ([0-9])"
        .Replacement.Text = "^s\1"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces after numbers are non-breaking
        .Text = "([0-9]) "
        .Replacement.Text = "\1^s"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers in the array are ordinary spaces
        For i = 0 To UBound(ArrFnd)
          .Text = "^s([0-9]{1,}^s" & ArrFnd(i) & ")"
          .Replacement.Text = " \1"
          .Execute Replace:=wdReplaceAll
        Next
        .MatchWildcards = False
        'Delete white spaces before paragraph breaks
        .Text = "^w^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        'Delete white spaces after paragraph breaks
        .Text = "^p^w"
        .Execute Replace:=wdReplaceAll
        'Replace smart single quotes with straight single quotes
        .Text = "'"
        .Replacement.Text = Chr(39)
        .Execute Replace:=wdReplaceAll
       'Replace smart double quotes with straight double quotes
        .Text = """"
        .Replacement.Text = Chr(34)
        .Execute Replace:=wdReplaceAll
        'Delete periods in a.m./p.m. and a.m/p.m
        .MatchWildcards = True
        .Text = "[^s ]([ap]).m."
        .Replacement.Text = "^s\1m"
        .Execute Replace:=wdReplaceAll
       .Text = "[^s ]([ap]).m>"
        .Execute Replace:=wdReplaceAll
        'Delete spaces in before am/pm
        .Text = "([0-9])[^s ]([ap]m)"
        .Replacement.Text = "\1\2"
        .Execute Replace:=wdReplaceAll
        'Delete - following a : or ;
        .Text = "([\:\;])-"
       .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace all double + spaces with single spaces of the same kind as the first
        .Text = "([^s ])[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace ie formatting
       .Text = "<ie"
        .Replacement.Text = "i.e."
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace i.e formatting
        .Text = "<i.e"
        .Replacement.Text = "i.e."
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace eg formatting
        .Text = "<eg"
        .Replacement.Text = "e.g."
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace e.g formatting
        .Text = "<e.g"
        .Replacement.Text = "e.g."
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace etc formatting
        .Text = "<etc"
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
        .Text = "<etc>"
        .Execute Replace:=wdReplaceAll
        'Ensure H.M. & HM appear as HM followed by a non-breaking space
        .Execute Replace:=wdReplaceAll
        .Text = "<HM[^s ]{1,}"
        .Replacement.Text = "HM^s"
        .Execute Replace:=wdReplaceAll
        .Text = "<H.M.[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Ensure there are two ordinary spaces following . and ?
        .Text = "([.\?])[^s ]"
        .Replacement.Text = "\1  "
        .Execute Replace:=wdReplaceAll
        'Restore i.e., e.g. & etc. formatting
        .Text = ""
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Remove hyphens from e-mail
        .Text = "e-mail"
        .Replacement.Text = "email"
        .Execute Replace:=wdReplaceAll
        'Delete non-breaking spaces before double-quotes
       .Text = "^s"""
        .Replacement.Text = """"
        .Execute Replace:=wdReplaceAll
        'Delete spaces before non breaking space space , : ; )
        .Text = "[^s ]([\,\:\;\.)])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Delete spaces before , : ; )
        .Text = "[ ]([\,\:\;\.)])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace hyphens
        .Text = "-"
        .Replacement.Text = "-"
        .Execute Replace:=wdReplaceAll
        'Replace non-breaking spaces with ordinary spaces before 'and' when followed by a non-breaking space
        .Text = "^sand^s"
        .Replacement.Text = " and^s"
        .Execute Replace:=wdReplaceAll
        'Replace two spaces with one space before 'and'
        .Text = "  and"
        .Replacement.Text = " and"
        .Execute Replace:=wdReplaceAll
        'Replace repeated full stops with single full stop
        .Text = "[.]{2,}"
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Ensure 'no.' is followed by a non breaking space
        .Text = "no.  "
        .Replacement.Text = "no.^s"
        .Execute Replace:=wdReplaceAll
      End With
    End With
    End Sub

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    At least part of your problem seems to be that you have multiple macros working at cross-purposes. In this post: http://windowssecrets.com/forums/sho...=1#post1049059 I provided a macro that handles such abbreviations in a way that avoids the double-spacing issues.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thanks for your reply - as that post was marked solved I didn't know how to reopen it again. I am using the macro you kindly sorted for me from that post. I found a problem with it in that the original macro was set up for i.e. or e.g. to convert to ie and eg and this is incorrect. I have tried to change this in your macro so that ie or eg becomes i.e. or e.g. but because somewhere in the macro converts spaces after full stops to two spaces, the part where it is supposed to restore the abbreviations to one spaces doesn't work. Regards, Shelley - my apologises for opening another post on this.

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Using the macro in post #8 in that thread, abbreviations like 'i.e.' are turned into 'ie' temporarily, so that the periods ending sentences can get their double-spaces, before the characters get replaced with the original periods. Accordingly, it obviates the problems you're having with your current macro.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  5. #5
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Thanks Macropod I have copied the macro again as for some reason in my Word document the were not present I the coding. Thanks for your help - regards, Shelley

  6. #6
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod - can you tell me what means in coding and how do you insert it. I've copied my clean up macro to a colleagues pc but it didn't copy across the for some reason. I know in word documents it is a return sign but don't know what it means in coding.

    Also how can I get the macro to run in the main body of the document and also in footnotes. I've tried adding the coding in bold at the beginning of the macro but it doesn't seem to like it.


    Code:
    Sub DPU_HouseStyleFormatCleanUp()
    Dim StrFnd As String, i As Long
      Dim aRng As Range
      Application.ScreenUpdating = False
      For Each aRng In ActiveDocument.StoryRanges
        With aRng.Find[/B]
    Dim Fld As Field, Rng As Range, i As Long, ArrFnd
    ArrFnd = Array("[Mm]inute", "[Hh]our", "[Dd]ay", "[Ww]eek", "[Mm]onth", "[Yy]ear", "[Ww]orking", "[Bb]usiness", "Act")
    With ActiveDocument
      'ensure spaces after cross-references are non-breaking
      For Each Fld In .Fields
        If Fld.Type = wdFieldRef Then
          Set Rng = Fld.Result.Previous.Characters(1)
          Rng.Text = Replace(Rng.Text, " ", Chr(160))
        End If
      Next
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        'Ensure spaces withing dates are non-breaking
        .Text = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
        .Replacement.Text = "\1^s\2^s\3"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers are non-breaking
        .Text = " ([0-9])"
        .Replacement.Text = "^s\1"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces after numbers are non-breaking
        .Text = "([0-9]) "
        .Replacement.Text = "\1^s"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers in the array are ordinary spaces
        For i = 0 To UBound(ArrFnd)
          .Text = "^s([0-9]{1,}^s" & ArrFnd(i) & ")"
          .Replacement.Text = " \1"
          .Execute Replace:=wdReplaceAll
        Next
        .MatchWildcards = False
        'Delete white spaces before paragraph breaks
        .Text = "^w^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        'Delete white spaces after paragraph breaks
        .Text = "^p^w"
        .Execute Replace:=wdReplaceAll
        'Replace smart single quotes with straight single quotes
        .Text = "'"
        .Replacement.Text = Chr(39)
        .Execute Replace:=wdReplaceAll
        'Replace smart double quotes with straight double quotes
        .Text = """"
        .Replacement.Text = Chr(34)
        .Execute Replace:=wdReplaceAll
        'Delete periods in a.m./p.m.
        .MatchWildcards = True
        .Text = "[^s ]([ap]).m."
        .Replacement.Text = "^s\1m"
        .Execute Replace:=wdReplaceAll
        .Text = "[^s ]([ap]).m>"
        .Execute Replace:=wdReplaceAll
        'Delete spaces in # am/pm
        .Text = "([0-9])[^s ]([ap]m)"
        .Replacement.Text = "\1\2"
        .Execute Replace:=wdReplaceAll
        'Delete - following a : or ;
        .Text = "([\:\;\.])-"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace all double + spaces with single spaces of the same kind as the first
        .Text = "([^s ])[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Replace repeated . with single .
        .Text = "[.]{2,}"
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Temporarily replace i.e. formatting
        .Text = "<i.e."
        .Replacement.Text = "ie"
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace e.g. formatting
        .Text = "<e.g."
        .Replacement.Text = "eg"
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        'Temporarily replace etc. formatting
        .Execute Replace:=wdReplaceAll
        .Text = "<etc."
        .Replacement.Text = "etc"
        .Execute Replace:=wdReplaceAll
        .Text = "<etc>"
        .Execute Replace:=wdReplaceAll
        'Ensure H.M. & HM appear as HM followed by both a non-breaking space and an ordinary space
        .Execute Replace:=wdReplaceAll
        .Text = "<HM[^s ]{1,}"
        .Replacement.Text = "HM^s "
        .Execute Replace:=wdReplaceAll
        .Text = "<H.M.[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Ensure there are two ordinary spaces following . and ?
        .Text = "([.\?])[^s ]"
        .Replacement.Text = "\1  "
        .Execute Replace:=wdReplaceAll
        'Restore i.e., e.g. & etc. formatting
        .Text = ""
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Remove hyphens from e-mail
        .Text = "e-mail"
        .Replacement.Text = "email"
        .Execute Replace:=wdReplaceAll
        'Delete non-breaking spaces before double-quotes
        .Text = "^s"""
        .Replacement.Text = """"
        .Execute Replace:=wdReplaceAll
        'Delete spaces before , : ; )
        .Text = "[^s ]([\,\:\;\.)])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace hyphens. Why?
        .Text = "-"
        .Replacement.Text = "-"
        .Execute Replace:=wdReplaceAll
        'Replace non-breaking spaces with ordinary spaces before 'and' when followed by a non-breaking space
        .Text = "^sand^s"
        .Replacement.Text = " and^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'no.' is followed by a non breaking space
        .Text = "no.  "
        .Replacement.Text = "no.^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'etc...' only has one .
        .Text = "etc..."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
         'Ensure 'etc..' only has one .
        .Text = "etc.."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
      End With
    Next aRng
    End With
    End Sub
    Last edited by Lady-Laughsalot; 2016-03-31 at 09:55.

  7. #7
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    The is just an ordinary character you're unlikely to find in most documents, so should be relatively safe to use as a temporary placeholder. It's created via Alt-0182. One could just as easily use some other character that doesn't occur in the documents.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  8. #8
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thanks for the explanation I was trying all sorts to insert it. I have now got it to work on my colleagues computer.

    I am still having problems trying to get the code above to search and replace in footnotes as well the body of the document, if you could give me some guidance I would very much appreciate it. Regards, Shelley

  9. #9
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    IIRC, all the code we've discussed so far only processes the document body; headers/footers, footnotes, endnotes, textboxes, etc. are not processed. For code to process all these ranges, see: http://www.msofficeforums.com/word-v...html#post90012
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  10. #10
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thanks for the link, however, I am really struggling of where to insert the coding, I've tried various ways but keep coming up with error messages. Regards, Shelley

    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter
    With ActiveDocument
      For Each Rng In .StoryRanges
        Call FndRepRng(Rng)
      Next
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Headers
          With HdFt
            If .LinkToPrevious = False Then
              Call FndRepRng(HdFt.Range)
            End If
          End With
        Next
        For Each HdFt In Sctn.Footers
          With HdFt
            If .LinkToPrevious = False Then
              Call FndRepRng(HdFt.Range)
            End If
          End With
        Next
      Next
    End With
    End Sub


    Code:
    Sub DPU_HouseStyleFormatCleanUp()
    Application.ScreenUpdating = False
    Dim Fld As Field, Rng As Range, i As Long, ArrFnd
    ArrFnd = Array("[Mm]inute", "[Hh]our", "[Dd]ay", "[Ww]eek", "[Mm]onth", "[Yy]ear", "[Ww]orking", "[Bb]usiness", "Act")
    With ActiveDocument
      'ensure spaces after cross-references are non-breaking
      For Each Fld In .Fields
        If Fld.Type = wdFieldRef Then
          Set Rng = Fld.Result.Previous.Characters(1)
          Rng.Text = Replace(Rng.Text, " ", Chr(160))
        End If
      Next
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        'Ensure spaces withing dates are non-breaking
        .Text = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
        .Replacement.Text = "\1^s\2^s\3"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers are non-breaking
        .Text = " ([0-9])"
        .Replacement.Text = "^s\1"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces after numbers are non-breaking
        .Text = "([0-9]) "
        .Replacement.Text = "\1^s"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers in the array are ordinary spaces
        For i = 0 To UBound(ArrFnd)
          .Text = "^s([0-9]{1,}^s" & ArrFnd(i) & ")"
          .Replacement.Text = " \1"
          .Execute Replace:=wdReplaceAll
        Next
        .MatchWildcards = False
        'Delete white spaces before paragraph breaks
        .Text = "^w^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        'Delete white spaces after paragraph breaks
        .Text = "^p^w"
        .Execute Replace:=wdReplaceAll
        'Replace smart single quotes with straight single quotes
        .Text = "'"
        .Replacement.Text = Chr(39)
        .Execute Replace:=wdReplaceAll
        'Replace smart double quotes with straight double quotes
        .Text = """"
        .Replacement.Text = Chr(34)
        .Execute Replace:=wdReplaceAll
        'Delete periods in a.m./p.m.
        .MatchWildcards = True
        .Text = "[^s ]([ap]).m."
        .Replacement.Text = "^s\1m"
        .Execute Replace:=wdReplaceAll
        .Text = "[^s ]([ap]).m>"
        .Execute Replace:=wdReplaceAll
        'Delete spaces in # am/pm
        .Text = "([0-9])[^s ]([ap]m)"
        .Replacement.Text = "\1\2"
        .Execute Replace:=wdReplaceAll
        'Delete - following a : or ;
        .Text = "([\:\;\.])-"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace all double + spaces with single spaces of the same kind as the first
        .Text = "([^s ])[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Replace repeated . with single .
        .Text = "[.]{2,}"
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Temporarily replace i.e. formatting
        .Text = "<i.e."
        .Replacement.Text = "ie"
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace e.g. formatting
        .Text = "<e.g."
        .Replacement.Text = "eg"
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        'Temporarily replace etc. formatting
        .Execute Replace:=wdReplaceAll
        .Text = "<etc."
        .Replacement.Text = "etc"
        .Execute Replace:=wdReplaceAll
        .Text = "<etc>"
        .Execute Replace:=wdReplaceAll
        'Ensure H.M. & HM appear as HM followed by both a non-breaking space and an ordinary space
        .Execute Replace:=wdReplaceAll
        .Text = "<HM[^s ]{1,}"
        .Replacement.Text = "HM^s "
        .Execute Replace:=wdReplaceAll
        .Text = "<H.M.[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Ensure there are two ordinary spaces following . and ?
        .Text = "([.\?])[^s ]"
        .Replacement.Text = "\1  "
        .Execute Replace:=wdReplaceAll
        'Restore i.e., e.g. & etc. formatting
        .Text = ""
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Remove hyphens from e-mail
        .Text = "e-mail"
        .Replacement.Text = "email"
        .Execute Replace:=wdReplaceAll
        'Delete non-breaking spaces before double-quotes
        .Text = "^s"""
        .Replacement.Text = """"
        .Execute Replace:=wdReplaceAll
        'Delete spaces before , : ; )
        .Text = "[^s ]([\,\:\;\.)])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace hyphens. Why?
        .Text = "-"
        .Replacement.Text = "-"
        .Execute Replace:=wdReplaceAll
        'Replace non-breaking spaces with ordinary spaces before 'and' when followed by a non-breaking space
        .Text = "^sand^s"
        .Replacement.Text = " and^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'no.' is followed by a non breaking space
        .Text = "no.  "
        .Replacement.Text = "no.^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'etc...' only has one .
        .Text = "etc..."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
         'Ensure 'etc..' only has one .
        .Text = "etc.."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
      End With
    End With
    End Sub

  11. #11
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    All you need to make the Demo macro work is to make a few changes to your DPU_HouseStyleFormatCleanUp macro:
    Code:
    Sub FndRepRng(RngFnd As Range)
    Application.ScreenUpdating = False
    Dim Fld As Field, Rng As Range, i As Long, ArrFnd
    ArrFnd = Array("[Mm]inute", "[Hh]our", "[Dd]ay", "[Ww]eek", "[Mm]onth", "[Yy]ear", "[Ww]orking", "[Bb]usiness", "Act")
    With RngFnd
      'ensure spaces after cross-references are non-breaking
      For Each Fld In .Fields
        If Fld.Type = wdFieldRef Then
          Set Rng = Fld.Result.Previous.Characters(1)
          Rng.Text = Replace(Rng.Text, " ", Chr(160))
        End If
      Next
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        'Ensure spaces withing dates are non-breaking
        .Text = "(<[0-9]{1,2})[^s ]([JFMASOND][anuryebchpilgstmov]{2,8})[^s ]([0-9]{4}>)"
        .Replacement.Text = "\1^s\2^s\3"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers are non-breaking
        .Text = " ([0-9])"
        .Replacement.Text = "^s\1"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces after numbers are non-breaking
        .Text = "([0-9]) "
        .Replacement.Text = "\1^s"
        .Execute Replace:=wdReplaceAll
        'Ensure spaces before numbers in the array are ordinary spaces
        For i = 0 To UBound(ArrFnd)
          .Text = "^s([0-9]{1,}^s" & ArrFnd(i) & ")"
          .Replacement.Text = " \1"
          .Execute Replace:=wdReplaceAll
        Next
        .MatchWildcards = False
        'Delete white spaces before paragraph breaks
        .Text = "^w^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        'Delete white spaces after paragraph breaks
        .Text = "^p^w"
        .Execute Replace:=wdReplaceAll
        'Replace smart single quotes with straight single quotes
        .Text = "'"
        .Replacement.Text = Chr(39)
        .Execute Replace:=wdReplaceAll
        'Replace smart double quotes with straight double quotes
        .Text = """"
        .Replacement.Text = Chr(34)
        .Execute Replace:=wdReplaceAll
        'Delete periods in a.m./p.m.
        .MatchWildcards = True
        .Text = "[^s ]([ap]).m."
        .Replacement.Text = "^s\1m"
        .Execute Replace:=wdReplaceAll
        .Text = "[^s ]([ap]).m>"
        .Execute Replace:=wdReplaceAll
        'Delete spaces in # am/pm
        .Text = "([0-9])[^s ]([ap]m)"
        .Replacement.Text = "\1\2"
        .Execute Replace:=wdReplaceAll
        'Delete - following a : or ;
        .Text = "([\:\;\.])-"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace all double + spaces with single spaces of the same kind as the first
        .Text = "([^s ])[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Replace repeated . with single .
        .Text = "[.]{2,}"
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Temporarily replace i.e. formatting
        .Text = "<i.e."
        .Replacement.Text = "ie"
        .Execute Replace:=wdReplaceAll
        .Text = "<ie>"
        .Execute Replace:=wdReplaceAll
        'Temporarily replace e.g. formatting
        .Text = "<e.g."
        .Replacement.Text = "eg"
        .Execute Replace:=wdReplaceAll
        .Text = "<eg>"
        'Temporarily replace etc. formatting
        .Execute Replace:=wdReplaceAll
        .Text = "<etc."
        .Replacement.Text = "etc"
        .Execute Replace:=wdReplaceAll
        .Text = "<etc>"
        .Execute Replace:=wdReplaceAll
        'Ensure H.M. & HM appear as HM followed by both a non-breaking space and an ordinary space
        .Execute Replace:=wdReplaceAll
        .Text = "<HM[^s ]{1,}"
        .Replacement.Text = "HM^s "
        .Execute Replace:=wdReplaceAll
        .Text = "<H.M.[^s ]{1,}"
        .Execute Replace:=wdReplaceAll
        'Ensure there are two ordinary spaces following . and ?
        .Text = "([.\?])[^s ]"
        .Replacement.Text = "\1  "
        .Execute Replace:=wdReplaceAll
        'Restore i.e., e.g. & etc. formatting
        .Text = ""
        .Replacement.Text = "."
        .Execute Replace:=wdReplaceAll
        'Remove hyphens from e-mail
        .Text = "e-mail"
        .Replacement.Text = "email"
        .Execute Replace:=wdReplaceAll
        'Delete non-breaking spaces before double-quotes
        .Text = "^s"""
        .Replacement.Text = """"
        .Execute Replace:=wdReplaceAll
        'Delete spaces before , : ; )
        .Text = "[^s ]([\,\:\;\.)])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
        'Replace hyphens. Why?
        .Text = "-"
        .Replacement.Text = "-"
        .Execute Replace:=wdReplaceAll
        'Replace non-breaking spaces with ordinary spaces before 'and' when followed by a non-breaking space
        .Text = "^sand^s"
        .Replacement.Text = " and^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'no.' is followed by a non breaking space
        .Text = "no.  "
        .Replacement.Text = "no.^s"
        .Execute Replace:=wdReplaceAll
        'Ensure 'etc...' only has one .
        .Text = "etc..."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
         'Ensure 'etc..' only has one .
        .Text = "etc.."
        .Replacement.Text = "etc."
        .Execute Replace:=wdReplaceAll
      End With
    End With
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  12. #12
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thanks for your reply - unfortunately I'm more confused than ever, the macro won't work at all now, I know I've done something wrong I'm just not experienced enough I guess to deal with complicated coding like this. Thanks for your help it is very much appreciated, I'm just glad its Friday. Regards, Shelley

  13. #13
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Did you add it and the 'Demo' macro to your document, then run the 'Demo' macro?
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  14. #14
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi, not sure if I'm supposed to be running one macro or two - I tried adding the demo coding to the Clean Up macro as well as the bits you highlighted but it doesn't work - I'm finding this confusing 'Sub FndRepRng(RngFnd As Range)' as it separates the coding into two codes

  15. #15
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    You put both subs into a code module and run the Demo macro. Simple as that.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •