Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-27-2015, 03:21 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default Macro to replace text and track changes based on user-defined rules

Dear all,



I am completely new to VBA, but I use Word to edit large technical documents daily using Track Changes. The aim is partly to produce a consistent style among the documents.

As a result, I end up making similar changes to multiple documents daily.

To improve my productivity, I would like to be able to define rules, for example "for the whole word CO2, subscript the 2" and have a macro apply those changes to the documents I'm working on.

In my workflow, I would run this macro first, before making any other changes. I would need the changes to be tracked as if I had made them manually. I would need to be able to create, save, and reload multiple rule sets, each containing a large number of rules, and some of the rules within each set would be quite complex.

An example of a more complex rule is "when there are two words in italics, and the first of those words is capitalized (Example here), for subsequent instances of the same two words (but not for the first instance in the document), shorten the first word to the initial letter (E. here)".

I'm looking for advice. My questions are:

1. Is there an existing program, add-in, or macro that can perform these types of operations?

2. If not, would it be very difficult to design such a macro?

Apologies if this is a question that has been asked before. I was unable to find anything similar on Google or using the forum search function.

Any help is much appreciated.

Best wishes,

Chris
Reply With Quote
  #2  
Old 12-27-2015, 04:38 AM
gmaxey gmaxey is offline Macro to replace text and track changes based on user-defined rules Windows 7 32bit Macro to replace text and track changes based on user-defined rules Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,427
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

1. Yes. There are undoubtedly hundreds of macros scattered about which are designed to perform these types of operations. Whether anyone as combined those into a ready made tool (add-in) to meet your exact requirements is unlikely.

2. Designing the macro would be a matter (degree of difficulty depends on the designer's skill level) of creating the individual parts.

Here is a start:

Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim lngIndex As Long
  ActiveDocument.TrackRevisions = True
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "CO2"
    .MatchWholeWord = True
    While .Execute
      If Not oRng.Characters(2).Font.Superscript = True Then
       oRng.Characters(2).Font.Superscript = True
      End If
      oRng.Collapse wdCollapseEnd
    Wend
    Set oRng = ActiveDocument.Range
    lngIndex = 0
      With oRng.Find
        .Text = "<*> <*>"
        .Font.Italic = True
        .MatchWildcards = True
        While .Execute
          lngIndex = lngIndex + 1
          If Not lngIndex = 1 Then
            oRng.Words(1) = oRng.Words(1).Characters(1) & ". "
          End If
          oRng.Collapse wdCollapseEnd
        Wend
      End With
  End With
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #3  
Old 12-28-2015, 04:49 AM
macropod's Avatar
macropod macropod is offline Macro to replace text and track changes based on user-defined rules Windows 7 64bit Macro to replace text and track changes based on user-defined rules Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

FWIW, I wrote the following macro some years back - it will search the active document for all numbers preceded by a letter or a right bracket, and subscript just the numbers. Thus, C5H8(N2S)4 becomes C5H8(N2S)4, whilst 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2 becomes 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2. Unless you're working with isotopes, the results should be correct - you'll need to apply the isotope superscripting yourself (if the numbers are already superscripted, they’ll be left alone).

If your document has other alphanumeric strings in which a non-superscripted number follows a letter (eg Table cell references), you’ll need to select only the range(s) containing the text to be converted and answer ‘No’ to the prompt.
Code:
Sub ChemPwrFmt()
Application.ScreenUpdating = False
Dim oRng As Range, fRng As Range, bState As Boolean 
Select Case MsgBox("Do you want to process the whole document?", _
    vbYesNoCancel + vbQuestion, "Chemical/Power Formatter")
  Case vbYes
    bState = True
  Case vbNo
    bState = False
  Case vbCancel
    End
End Select
With Selection
  Set oRng = .Range
  With .Find
    .ClearFormatting
    .Text = "[A-Za-z)][0-9]{1,}"
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Forward = True
    Do While .Execute = True
      Set fRng = ActiveDocument.Range(Start:=Selection.Start + 1, End:=Selection.End)
      If bState = False Then
        If fRng.Start >= oRng.End Then Exit Do
        If fRng.End >= oRng.End Then fRng.End = oRng.End
      End If
      If fRng.Font.Superscript = False Then fRng.Font.Subscript = True
      fRng.Collapse Direction:=wdCollapseEnd
    Loop
  End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #4  
Old 01-04-2016, 02:30 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default

Dear Greg and Paul,

Thanks so much for your help. The pieces of code you posted are really useful and already make my working day a little easier. I will put some time aside to studying VBA and see if I can write some useful macros myself over time.

Cheers,

Chris
Reply With Quote
  #5  
Old 01-04-2016, 03:41 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default

Another quick question...

I'm using the following snippet of code as an extension to what Greg wrote



.Text = "[0-9]-[0-9]"
.MatchWildcards = True
.MatchWholeWord = False
.Replacement.Text = "–"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue

How can I amend this to only replace the 2nd character of the found text? I've tried putting ".Character(2)" in various places, and a few other ideas, but to no avail. Thanks.

Also, instead of using "ActiveDocument.Range" is there a way to get the macro to ignore deleted text in Track Changes revisions?
Reply With Quote
  #6  
Old 01-04-2016, 03:50 AM
macropod's Avatar
macropod macropod is offline Macro to replace text and track changes based on user-defined rules Windows 7 64bit Macro to replace text and track changes based on user-defined rules Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

What do you want to replace the second character with?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 01-04-2016, 03:54 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default

I'm aiming to replace hyphens with an 'en dash' character ("–") in numerical ranges, e.g., "21-42" -> "21–42".
Reply With Quote
  #8  
Old 01-04-2016, 05:20 AM
macropod's Avatar
macropod macropod is offline Macro to replace text and track changes based on user-defined rules Windows 7 64bit Macro to replace text and track changes based on user-defined rules Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

In that case:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9])-([0-9])"
    .Replacement.Text = "\1^0150\2"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #9  
Old 01-04-2016, 09:41 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default

Thanks Paul.

That works well with Track Changes off. However... with Track Changes on, that code converts 44-55 to 445–5.
Reply With Quote
  #10  
Old 01-04-2016, 04:19 PM
macropod's Avatar
macropod macropod is offline Macro to replace text and track changes based on user-defined rules Windows 7 64bit Macro to replace text and track changes based on user-defined rules Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For use with Track Changes, try:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9])-([0-9])"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    .Characters(2).Text = Chr(150)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #11  
Old 01-05-2016, 07:55 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Question

Works perfectly. Thanks so much!

I've been adapting your code to make various replacements and it does the job really well. I'm flying through the changes I need to code (except the complex stuff). The main "simple" thing I'm struggling with is finding and replacing Unicode characters. Specifically:

1. Replacing apostrophes after numbers with prime symbols, e.g. 3' -> 3′.

2. Replacing the string "space hyphen number" with the string "space minus sign number", e.g., -3 -> −3.

3. For percentage ranges written with 2 percentage signs and an en dash, delete the first percentage sign, e.g., 5%–30% -> 5–30%. I made this work for hyphens but not en dashes.

I've tried things like ".Text = ChrW(###)", with both hexadecimal and decimal codes, but I haven't been able to make .Find latch on to Unicode characters at all so far...
Reply With Quote
  #12  
Old 01-05-2016, 08:13 AM
gmaxey gmaxey is offline Macro to replace text and track changes based on user-defined rules Windows 7 32bit Macro to replace text and track changes based on user-defined rules Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,427
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

For number 1:

Sub Test()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "([0-9]{1,})(" & Chr(39) & ")"
.MatchWildcards = True
.Replacement.Text = "\1" & ChrW(8242)
.Execute Replace:=wdReplaceAll
End With
lbl_Exit:
Exit Sub
End Sub

We won't give you all of the fish since you seem willing to learn to fish ;-)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #13  
Old 01-09-2016, 06:27 AM
Thefirstfish` Thefirstfish` is offline Macro to replace text and track changes based on user-defined rules Windows 10 Macro to replace text and track changes based on user-defined rules Office 2016
Novice
Macro to replace text and track changes based on user-defined rules
 
Join Date: Dec 2015
Posts: 11
Thefirstfish` is on a distinguished road
Default

Thank you again!

Based on your helpful advice, I solved those 3 problems and a few more. My macro is now getting quite large (about 1700 lines and growing daily).

I'm now stuck on a point concerning field codes...

The current version of my macro contains the following code, thanks to the previous information in this thread:

Quote:
'For replacing hyphens in numerical ranges with an en dash
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[0-9]-[0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While oRng.Find.Found = True
If oRng.Characters(3).Font.Superscript = False Then
oRng.Characters(2).Text = Chr(150)
oRng.Collapse wdCollapseEnd
oRng.Find.Execute
End If
Loop
Is there a line I can add to this to make it ignore (i.e., make no changes to) text that contains a field code?

I'm grateful for your expert help with all of these questions. I'm enjoying dabbling in coding and the experience has inspired me to sign up to an 'Intro to Computer Science' course.
Reply With Quote
  #14  
Old 01-09-2016, 07:14 AM
gmaxey gmaxey is offline Macro to replace text and track changes based on user-defined rules Windows 7 32bit Macro to replace text and track changes based on user-defined rules Office 2010 (Version 14.0)
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,427
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Numbered Fish,

Something weird going on here (Paul help us out).

I opened and new document and entered:

1-{Qoute "1"}

When toggled the content looks like this:

1-1

I ran your macro and NOTHING happened!

Like you seem to want to prevent, I thought would have occurred. Here is some code that illustrates the weird behavior that seems to be due to the "-" (dash) in the .Find string:

Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
'For replacing hyphens in numerical ranges with an en dash
Dim oRNg As Word.Range
  Set oRNg = ActiveDocument.Range
  With oRNg.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    'Note using 1-{Quote "1"} toggled to display 1-1
    .Text = "[0-9]-[0-9]" 'Wasn't found
    .Text = "[0-9]" & Chr(45) & "[0-9]" 'Wasn't found
    .Text = "[0-9]-" 'Found
    'Remove "-" between displayed numbers
    .Text = "[0-9][0-9]" 'Found
    'Put dash back between numbers
    .Text = "[0-9]*[0-9]" 'Found
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    While .Execute
      If oRNg.Characters(2) = Chr(45) Then
        If oRNg.Fields.Count = 0 Then
          If oRNg.Characters(3).Font.Superscript = False Then
            oRNg.Characters(2).Text = Chr(150)
            oRNg.Collapse wdCollapseEnd
            oRNg.Find.Execute
          End If
        End If
      End If
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub
Paul, do you have any explanation?

Best Regards,
Greg Maxey
The problem with socialism is that you eventually run out of other peoples' money. ~Margaret Thatcher
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
Reply

Tags
editing, macro, tracked changes

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to replace text and track changes based on user-defined rules FileSystemObject Compile Error: User-Defined Type Not Defined gsrikanth Excel Programming 2 03-28-2022 06:32 AM
User Defined Fields daveybops Outlook 1 05-06-2014 10:25 AM
Macro to replace text and track changes based on user-defined rules Word VBA Macro to Find and Replace based on the Alt Text of an Image bennymc Word VBA 1 01-27-2014 04:23 PM
Macro to replace text and track changes based on user-defined rules User-defined Type not Defined VBA Issue OTPM Project 3 01-02-2014 01:47 PM
Macro to replace text and track changes based on user-defined rules Change standard highlight text color to user defined Scott Duffens Word 2 06-18-2012 03:53 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 08:09 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft