[Solved] Word Macro issues

[yanlok1345]

Hello everyone,

I'm working on a Microsoft Word Macro that aims to perform the following tasks:

1) Check if the 000000 in the second column of a Word Document are in increasing order.
2) If not, change the font colour of the wrong 6-digit number to wdred and track the changes.
3) Check if the digit numbers in the second column of a Word Document are 000000. If not, change them to wdred and track the changes.
4) If any changes have been made, a message box will pop up saying, "Some of them are not in an increasing order."
4a) If no changes have been made, a message box will pop up saying, "No mistake is found."


Now there are two macros to complete the above tasks. Can they merge as one macro? I tried but failed due to some technical reasons.

For Checking the numbers are in ascending order:

I have drafted the code as follows but with bugs:

- sometimes it can identify the wrong 6-digit numbers(not in ascending order) but sometimes cannot
- sometimes if the wrong numbers are found, those 6-digit numbers after the wrong one will also be marked in wdRed.
- How can it just find and replace the numbers in the second column of the table?

Code: Select all

Sub CheckNo1()

    Dim doc As Document
    Dim rng As Range
    Dim num As String
    Dim prevNum As Long
    Dim sMade As Boolean

    Set doc = ActiveDocument
    Set rng = doc.Content

    With rng.Find
        .ClearFormatting
        .text = "([0-9]{6})"
        .MatchWildcards = True
        .Execute
        Do While .found
            num = .Parent.text
            If IsNumeric(num) Then
                If CLng(num) <= prevNum Then
                    .Parent.Font.Color = RGB(128, 200, 200)
                    sMade = False
                Else
                    prevNum = CLng(num)
                End If
            End If
            .Execute
        Loop
    End With
    
    If sMade Then
    MsgBox Prompt:="Please check the red-marked numbers"
    Else
    MsgBox Prompt:="No mistake."
    End If
    End If
   
End Sub

The code for Checking the numbers are in 000000:

Code: Select all

Sub CheckNo2()

    Dim doc As Document
    Dim rng As Range
    Dim sMade As Boolean


Set rng = ActiveDocument.Content
sMade = False

    With rng.Find
        .ClearFormatting
        .text = "\[[0-9]{4}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop

        Do While .Execute
            rng.Font.Color = RGB(128, 0, 0)
            rng.Collapse wdCollapseEnd
            sMade = True
        Loop
    End With

    With rng.Find
        .ClearFormatting
        .text = "\[[0-9]{5}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop

        Do While .Execute
            rng.Font.Color = RGB(128, 0, 0)
            rng.Collapse wdCollapseEnd
            sMade = True
        Loop
    End With
    
    With rng.Find
        .ClearFormatting
        .text = "\[[0-9]{7}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop

        Do While .Execute
            rng.Font.Color = RGB(128, 0, 0)
            rng.Collapse wdCollapseEnd
            sMade = True
        Loop
    End With
    
    With rng.Find
        .ClearFormatting
        .text = "\[[0-9]{8}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop

        Do While .Execute
            rng.Font.Color = RGB(128, 0, 0)
            rng.Collapse wdCollapseEnd
            sMade = True
        Loop
    End With
    
    With rng.Find
        .ClearFormatting
        .text = "\[[0-9]{9}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop

        Do While .Execute
            rng.Font.Color = RGB(128, 0, 0)
            rng.Collapse wdCollapseEnd
            sMade = True
        Loop
    End With
    
    If sMade Then
    MsgBox Prompt:="Please check the red-marked numbers."
    Else
    MsgBox Prompt:="No mistake."
    End If
    End If

End Sub

Thank you for your kind attention.

[HansV]

Your sample document doesn't provide much in the way of examples. Here is an attempt:

Code: Select all

Sub CheckBoth()
    Dim rng As Range
    Dim txt As String
    Dim num As Long
    Dim prevnum As Long
    Dim changesMade As Boolean

    If MsgBox("Would you like to check the numbers?", vbYesNo) = vbNo Then
        Exit Sub
    End If

    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop
        Do While .Execute
            txt = rng.Text
            If Len(txt) <> 8 Then
                changesMade = True
                rng.Font.Color = RGB(0, 128, 0)
            Else
                num = Val(Mid(txt, 2, Len(txt) - 2))
                If num < prevnum Then
                    changesMade = True
                    rng.Font.Color = RGB(128, 0, 0)
                Else
                    prevnum = num
                End If
            End If
        Loop
    End With

    If changesMade Then
        MsgBox Prompt:="Please check the numbers marked in red (decreasing) or green (not 6 digits)"
    Else
        MsgBox Prompt:="No mistake is found."
    End If

    Selection.HomeKey Unit:=wdStory
End Sub

[SpeakEasy]

Here's a quick alternative that tries to be in keeping with your existing code (i.e not a complete rewrite):

(minor edit now made to address requirement for green colour for not 6 digits that wasn't stated in original requirements)

Code: Select all

Sub CheckNo3()
    Dim response As VbMsgBoxResult
    Dim rng As Range
    Dim highestfound As String

    response = MsgBox("Would you like to check the 6-digit numbers?", vbYesNo)
    
    If response = vbYes Then
        ActiveDocument.TrackRevisions = True
        
        Set rng = ActiveDocument.Content
        
        With rng.Find
            .ClearFormatting
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            .Wrap = wdFindStop
            Do While .Execute
                If Len(rng.Text) <> 8 Or rng.Text < highestfound Then
                    rng.Font.Color = IIf(Len(rng.Text) <> 8, RGB(0, 128, 0), RGB(128, 0, 0))
                    rng.Collapse wdCollapseEnd
                Else
                    highestfound = rng.Text
                End If
             Loop
        End With
         
        If ActiveDocument.Revisions.Count > 0 Then
            MsgBox Prompt:="Please check the numbers marked in red (decreasing) or green (not 6 digits)"
        Else
            MsgBox Prompt:="No mistake is found."
        End If
        Selection.HomeKey Unit:=wdStory
    End If
End Sub

[yanlok1345]

Your sample document doesn't provide much in the way of examples. Here is an attempt:

Code: Select all

Sub CheckBoth()
    Dim rng As Range
    Dim txt As String
    Dim num As Long
    Dim prevnum As Long
    Dim changesMade As Boolean

    If MsgBox("Would you like to check the numbers?", vbYesNo) = vbNo Then
        Exit Sub
    End If

    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Text = "\[[0-9]{1,}\]"
        .MatchWildcards = True
        .Wrap = wdFindStop
        Do While .Execute
            txt = rng.Text
            If Len(txt) <> 8 Then
                changesMade = True
                rng.Font.Color = RGB(0, 128, 0)
            Else
                num = Val(Mid(txt, 2, Len(txt) - 2))
                If num < prevnum Then
                    changesMade = True
                    rng.Font.Color = RGB(128, 0, 0)
                Else
                    prevnum = num
                End If
            End If
        Loop
    End With

    If changesMade Then
        MsgBox Prompt:="Please check the numbers marked in red (decreasing) or green (not 6 digits)"
    Else
        MsgBox Prompt:="No mistake is found."
    End If

    Selection.HomeKey Unit:=wdStory
End Sub

I apologize for not giving a full example document as i edited the post many times during my time in researching how to merge them together without conflicting codes.

I want to express my heartfelt appreciation for your time and effort in creating this macro. Thank you for your generosity in sharing your skills and knowledge with me. I am grateful for your willingness to help.

Once again, thank you for creating such a fantastic macro. You are a true professional, and I am so grateful for your contribution.

[yanlok1345]

Here's a quick alternative that tries to be in keeping with your existing code (i.e not a complete rewrite):

(minor edit now made to address requirement for green colour for not 6 digits that wasn't stated in original requirements)

Code: Select all

Sub CheckNo3()
    Dim response As VbMsgBoxResult
    Dim rng As Range
    Dim highestfound As String

    response = MsgBox("Would you like to check the 6-digit numbers?", vbYesNo)
    
    If response = vbYes Then
        ActiveDocument.TrackRevisions = True
        
        Set rng = ActiveDocument.Content
        
        With rng.Find
            .ClearFormatting
            .Text = "\[[0-9]{1,}\]"
            .MatchWildcards = True
            .Wrap = wdFindStop
            Do While .Execute
                If Len(rng.Text) <> 8 Or rng.Text < highestfound Then
                    rng.Font.Color = IIf(Len(rng.Text) <> 8, RGB(0, 128, 0), RGB(128, 0, 0))
                    rng.Collapse wdCollapseEnd
                End If
                highestfound = rng.Text
            Loop
        End With
         
        If ActiveDocument.Revisions.Count > 0 Then
            MsgBox Prompt:="Please check the numbers marked in red (decreasing) or green (not 6 digits)"
        Else
            MsgBox Prompt:="No mistake is found."
        End If
        Selection.HomeKey Unit:=wdStory
    End If
End Sub

Thank you for your patience and help. I realize I made several edits to the post, causing you inconvenience, for which I apologize. I'm pleased to report that the issue is now resolved and everything is working well. Thank you again for your assistance!