VBA Swap text around

Shelley Lou · #1 11-27-2024, 12:51 AM

Many of the older type leases I convert to house style have the text written as schedule & number first then the part & number, they may be capitalised or lowercase and either separated with a comma or a space, depending on the document being converted. The text to be swapped around may also contain cross references or are written as plain text.

Our house style requires that the part & number comes first then the word 'of' and then the schedule & number e.g.:

Instances of Schedule 1, Part 1 should be part 1 of schedule 1; or

Instances of schedule 1 part 1 should be part 1 of schedule 1.

I've been researching on how to swap text but can't seem to find anything at all really. How would I go about swapping the text, include the word 'of' and the code to recognise if it’s a cross reference field or plain text. I'm a bit stumped.

Before
Before.JPG

After
After.JPG

Swap text Part and Schedule around.docx

macropod · #2 11-27-2024, 01:41 AM

You should be able to do this with a wildcard Find/Replace, where:
Find = ([Ss]chedule*)[, ]@([Pp]art*)([ ;.,])
Replace = \2 of \1\3

Shelley Lou · #3 11-27-2024, 02:01 AM

Hi Macropod, thank you so much for providing the find and replace. I've put it into a little macro but for some reason it will only work if the text and number are separated by non breaking spaces and doesn't work if its just separated with a space - what do I need to add to include both space and non breaking space? Thanks

Code:

Sub SwapText_SchedulePart()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchCase = False
  .MatchWildcards = True
  .text = "([Ss]chedule*)[, ]@([Pp]art*)([ ;.,])"
  .Replacement.text = "\2 of \1\3"
  .Execute Replace:=wdReplaceAll
End With
End Sub

macropod · #4 11-27-2024, 02:35 AM

The simple solution - which also helps stop the descriptors and numbers ending up on separate lines, is to use non-breaking spaces throughout:

Code:

Sub SwapText_SchedulePart()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Forward = True
  .Format = True
  .Text = "([Ss]chedule) "
  .Replacement.Text = "\1^s"
  .Execute Replace:=wdReplaceAll
  .Text = "([Pp]art) "
  .Replacement.Text = "\1^s"
  .Execute Replace:=wdReplaceAll
  .Text = "([Ss]chedule*)[, ]@([Pp]art*)([ ;.,])"
  .Replacement.Text = "\2 of \1\3"
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

You might even find it better for the last F/R expression to use:

Code:

  .Text = "[Ss](chedule*)[, ]@[Pp](art*)([ ;.,])"
  .Replacement.Text = "P\2 of S\1\3"

Shelley Lou · #5 11-27-2024, 02:58 AM

Thank you so much - I have used your alternative at the end but with a lowercase p and s which now makes it work even better - much appreciated.

Code:

Sub SwapText_SchedulePart()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Forward = True
  .Format = True
  .text = "([Ss]chedule) "
  .Replacement.text = "\1^s"
  .Execute Replace:=wdReplaceAll
  .text = "([Pp]art) "
  .Replacement.text = "\1^s"
  .Execute Replace:=wdReplaceAll
  .text = "[Ss](chedule*)[, ]@[Pp](art*)([ ;.,])"
  .Replacement.text = "p\2 of s\1\3"
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

macropod · #6 11-27-2024, 03:03 AM

Do be aware that doing that risks starting some sentences with a lower-case p, which is why I suggested the upper-case approach. The original code in the macro simply preserved whatever case it found, which could have produced some odd results at the start of sentences too (e.g. part 3 of Schedule 4 provides ... ).

Shelley Lou · #7 11-27-2024, 03:23 AM

Aaaah yes that could be a problem, our house style is lowercase part / schedule so may change it back to how it was originally to avoid any issues. Thanks for pointing that out.

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How do I swap managers and subordinates in org chart	weety	Visio	0	05-23-2024 08:50 AM
swap values	s7y	Excel Programming	0	05-15-2012 01:32 PM
macro to swap between letterhead	anno1404	Word VBA	7	03-31-2012 02:33 PM
How do I swap slides during a presentation?	Harper	PowerPoint	0	08-17-2011 09:13 AM
Swap file	office1983	Outlook	1	02-15-2011 07:11 AM