How do I change numbers in Word based on search and replace macro

jcaiola
jcaiola used Ask the Experts™
on
Need to create a macro that will search through a word document and change numbers to a different number format based on their original value. The macro has to be able to search through the entire document and only update the exact number with the change - not any other variant of the number (e.g. change 1.00 to 0001 but do not change 11.00 to 10001 - NOTE: 11.00 should change to 0011 instead). So - I want to search for specific numbers and change them throughout the whole document. The numbers are sequential, but I do not want earlier numbers to change numbers later in the document (see previous example).

There are words associated with each numbered row - see bottom of attached file.

Thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
GrahamSkanRetired
Top Expert 2012

Commented:
Your attempt at attaching the file seems to have failed.

Author

Commented:
Thanks Graham - attached properly now.
Example.docx
Here is a macro that I believe will meet your needs. As with any new codes, make sure you back up your data before you run this. It first removes the decimal and two digits to the right of it. It then formats your numbers. I've tried this on numerous number combinations and it seems to work. Hope it works for you.

Sub FormatNumbers()
Application.ScreenUpdating = False
 Dim Rng As Word.Range
       Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[.][0-9]{2,}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

   Set Rng = ActiveDocument.Range
     With Rng.Find
       .Text = "([0-9]{1,4})"
       .MatchWildcards = True
     While .Execute
       i = Rng
       Rng.Select
          Rng = Format(Rng, "0000")
       Rng.Collapse wdCollapseEnd
     Wend
   End With
Application.ScreenUpdating = True
End Sub

Open in new window


Paul
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
This is great - and works as expected, but there is one more wrinkle - I'm sorry I didn't explain this upfront and perhaps this can be augmented to accommodate the following:

Interspersed within the series of numbers (1.00, 2.00, 3.00) there are occasionally fractional numbers (4.01, 4.04, 7.01) that are translated differently according to the furthest left character. Example: (4.01 becomes 0004a, 4.02 becomes 0004b, 7.04 becomes 0007d). The last integer is related the the letter of the alphabet (1 = a, 2=b, 3=c, etc.). See attached.

Is this something that can be worked into the macro or can these fractional numbers be skipped over and addressed (as described above with a second macro)?

Thanks so much. This is very helpful.
Example2.docx
Will the second to the last digit always be zero (0)? If not, would .26 be "z"? .27 "aa"??

Author

Commented:
We would never get to .27 - rarely get about .14.

Thanks
You made me think on this one. Give this a try. It will replace everything between .01 and .26 with a to z and remove the rest.

Sub FormatNumbers()
 Dim Rng As Word.Range
 Dim a, i, s As Long
 Dim i2, i2 As Long

Application.ScreenUpdating = False

 i1 = 48
 i2 = 48
 a = 10
 For s = 1 To 100
   Selection.Find.ClearFormatting 'This will replace .01 to .26 with a to z and remove the rest
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." & chr(i1) & chr(i2)
        .Replacement.Text = chr(a)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    If i2 = 57 Then
      i1 = i1 + 1
    End If
      If i2 = 57 Then
        i2 = 48
          Else
            i2 = i2 + 1
              End If
              If a = 10 Then
            a = 97
          Else
        a = a + 1
      End If
    If s > 26 Then
      a = 10
    End If
  Next s
    
  Set Rng = ActiveDocument.Range 'This formats the remaining numbers as "0000"
     With Rng.Find
       .Text = "([0-9]{1,4})"
       .MatchWildcards = True
     While .Execute
       i = Rng
       Rng.Select
          Rng = Format(Rng, "0000")
       Rng.Collapse wdCollapseEnd
     Wend
  End With
  
Application.ScreenUpdating = True

End Sub

Open in new window

Sorry, I'm perplexed here. Thought I saved the last changes I made. This code should work:

Option Explicit
Sub FormatNumbers()
 Dim Rng As Word.Range
 Dim a, i, s As Long
 Dim i1, i2 As Long

Application.ScreenUpdating = False

 i1 = 48
 i2 = 48
 a = 10
 For s = 1 To 100
   Selection.Find.ClearFormatting 'This will replace .01 to .26 with a to z and remove the rest
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." & chr(i1) & chr(i2)
        .Replacement.Text = chr(a)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    If i2 = 57 Then
      i1 = i1 + 1
    End If
      If i2 = 57 Then
        i2 = 48
          Else
            i2 = i2 + 1
              End If
              If a = 10 Then
            a = 97
          Else
        a = a + 1
      End If
    If s > 26 Then
      a = 10
    End If
  Next s
    
  Set Rng = ActiveDocument.Range 'This formats the remaining numbers as "0000"
     With Rng.Find
       .Text = "([0-9]{1,4})"
       .MatchWildcards = True
     While .Execute
       i = Rng
       Rng.Select
          Rng = Format(Rng, "0000")
       Rng.Collapse wdCollapseEnd
     Wend
  End With
  
Application.ScreenUpdating = True

End Sub

Open in new window

Author

Commented:
This is incredible and almost exactly what I need. One tiny change - if possible on your side. I need to end the translated numbers with a ":". In the earlier version of this I was able to update your code by changing Rng = Format(Rng, "00000") to Rng = Format(Rng, "0000:"). That doesn't work anymore because of the letters which now format as: "1083:d" instead of "1083d:".

I can dig through the code and see where I can make this change, but it might be an easy fix for you.

Thanks again for your solution and turnaround.
This code seems to do the trick:

Option Explicit
Sub FormatNumbers()
 Dim Rng As Word.Range
 Dim a, i, s As Long
 Dim i1, i2 As Long

Application.ScreenUpdating = False

 i1 = 48
 i2 = 48
 a = 10
 For s = 1 To 100
 If s = 1 Or s > 26 Then
   Selection.Find.ClearFormatting 'This will replace .00 to .27 and above with ":"
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." & chr(i1) & chr(i2)
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
  Else
     Selection.Find.ClearFormatting 'This will replace .01 to .26 with :a to :z and remove the rest
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "." & chr(i1) & chr(i2)
        .Replacement.Text = chr(a)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
  End If
    Selection.Find.Execute Replace:=wdReplaceAll
    If i2 = 57 Then
      i1 = i1 + 1
    End If
      If i2 = 57 Then
        i2 = 48
          Else
            i2 = i2 + 1
              End If
              If a = 10 Then
            a = 97
          Else
        a = a + 1
      End If
    If s > 26 Then
      a = 10
    End If
  Next s
    
  Set Rng = ActiveDocument.Range 'This formats the remaining numbers as "0000"
     With Rng.Find
       .Text = "([0-9]{1,4})"
       .MatchWildcards = True
     While .Execute
       i = Rng
       Rng.Select
          Rng = Format(Rng, "0000")
       Rng.Collapse wdCollapseEnd
     Wend
  End With
  
Application.ScreenUpdating = True

End Sub

Open in new window

Author

Commented:
I think we are close - I am getting this now (as an example): - the whole numbers have colon, but the numbers+letters do not.

Thanks

0001:
0002:
0003:
0004:
0004d
0005:
0006:
0007:
0008:
0008d
That doesn't work anymore because of the letters which now format as: "1083:d" instead of "1083d:".

I thought you did not want those numbers with a letter to have a colon. The original code will give you that result if you change line 53 to

Rng = Format(Rng, "0000:").

Author

Commented:
I'm sorry if I confused the matter, and I appreciate your hanging in here with me. I had tried making that change and this was the result:

0001:
0002:
0003:
0004:
0004:d  - need it to be: 0004d:
0005:
0006:
0007:
0008:
0008:d - need it to be: 0008d:

Thanks again.
Oh, I see. In that last code I sent, change line 33 to this:

.Replacement.Text = chr(a) & ":"

Open in new window

Author

Commented:
Thanks for those who assisted here. Flyster - thank you so much about working through this with me and handling my updated requests to your code. Works like a dream.
You're welcome. And I thank you for the challenge!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial