Updating Word macro and adding a pop-up error message when applicable

Andreamary
Andreamary used Ask the Experts™
on
My current macro code (see code below) finds all instances of the following three string formats (which are work order #'s) in a Word 2010 file (the file can be anywhere from 10 to 100 pages) and pastes them into a new Word file, one string per line:
  AAA-#### (where AAA could be any letter from A – Z, followed by a dash, then 4 numbers)
  ####-####### (4 numbers, followed by a dash, then 7 numbers)
  AAA-##-#### (where AAA could be any letter from A – Z, followed by a dash, 2 numbers, a dash, then 4 numbers)

Two changes I would like to make to the above current macro:
  • I would like to update the macro so it only searches for one of the three text strings above (as the other two text strings have since become obsolete) to then paste into a new Word file, one string per line:
####-####### (4 numbers, followed by a dash, then 7 numbers)

  • I would like the macro to generate an error message as a dialog pop-up box at the first instance it comes across a text string that does not follow the approved format as outlined above (####-####### [4 numbers, followed by a dash, then 7 numbers], with the error message that includes the problem text string (work order #) to assist the user in locating the erroneously-entered work order number in the document and fixing it. Once the user corrected the work order number, the user would then re-run the macro.

The two instances of wrongly formatted strings for the macro to detect and generate an error message are as follows:
####-###### (4 numbers, followed by a dash, then 6 numbers)
####-######## (4 numbers, followed by a dash, then 8 numbers)

The error message will ensure going forward that we are not missing any work order numbers being transferred by the macro to the new Word file due to the user mis-keying in the work orders by accidentally adding or subtracting one digit.

I've attached a sample Word file showing the two examples of wrongly-formatted text strings that can occur and for which I would like the macro to generate an error message.

The current code is shown below:
Sub Extract_WOs_ADCs()
'
' Extract_WOs_ADCs Macro
'
' Keyboard Shortcut: Ctrl+y
'
    Set Activedoc = ActiveDocument
    strRes = ""
    Dim reg As Object 'VBScript_RegExp_55.regexp
    Dim Match As Object ' VBScript_RegExp_55.Match
    Dim Matches As Object 'VBScript_RegExp_55.MatchCollection

    ' instanciation
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Global = True
        .MultiLine = True
        .Ignorecase = True
        .Pattern = "\b([A-Z]{3}(-\d{2})?-\d{4}|\d{4}-\d{7})\b"
    Set Matches = .Execute(Activedoc.Range.Text)
    End With
    For Each Match In Matches
        strRes = strRes & Match.Value & vbCrLf
    Next Match
    
    If strRes <> "" Then
        Set newDoc = Documents.Add
        newDoc.Range.Text = strRes
    Else
        MsgBox "No Matches"
    End If
End Sub

Open in new window


I hope I've provided sufficient details. Please let me know if you have any questions...

Thanks!
Andrea
Sample_EE.docx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016
Commented:
Hi,

pls try
Sub Extract_WOs_ADCs()
'
' Extract_WOs_ADCs Macro
'
' Keyboard Shortcut: Ctrl+y
'
    Set Activedoc = ActiveDocument
    strRes = ""
    Dim reg As Object 'VBScript_RegExp_55.regexp
    Dim Match As Object ' VBScript_RegExp_55.Match
    Dim Matches As Object 'VBScript_RegExp_55.MatchCollection

    ' instanciation
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Global = True
        .MultiLine = True
        .Ignorecase = True
        .Pattern = "\b\d{4}-(\d{6}|\d{8})\b"
    Set Matches = .Execute(Activedoc.Range.Text)
    End With
    For Each Match In Matches
        ActiveDocument.Range(Match.firstIndex, Match.firstIndex + Match.Length).Select
        MsgBox "Value: " & Match.Value & " is wrong"
        Exit Sub
    Next Match
    reg.Pattern = "\b\d{4}-\d{7}\b"
    Set Matches = reg.Execute(Activedoc.Range.Text)
    For Each Match In Matches
        strRes = strRes & Match.Value & vbCrLf
    Next Match

    
    If strRes <> "" Then
        Set newDoc = Documents.Add
        newDoc.Range.Text = strRes
    Else
        MsgBox "No Matches"
    End If
End Sub

Open in new window

Regards

Author

Commented:
Hi Rgonzo,

Works like a charm, and thanks for the speedy response!

Cheers,
Andrea

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