asked on

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

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

GrahamSkan

Your attempt at attaching the file seems to have failed.

jcaiola

ASKER

Thanks Graham - attached properly now.
Example.docx

Flyster

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

jcaiola

ASKER

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

Flyster

Will the second to the last digit always be zero (0)? If not, would .26 be "z"? .27 "aa"??

jcaiola

ASKER

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

Thanks

Flyster

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

Flyster

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

jcaiola

ASKER

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.

Flyster

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

jcaiola

ASKER

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

Flyster

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:").

jcaiola

ASKER

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.

ASKER CERTIFIED SOLUTION

Flyster

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

jcaiola

ASKER

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.

Flyster

You're welcome. And I thank you for the challenge!