VBA Swap text around

macropod · #1 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 · #2 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

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