HELP: Use the Find & Replace to Verify Checksums

[Carson]

If your viewing this then either your looking for the same help as me, or your here to help. Both are welcome!

So Im trying to create a macro that I can use to search the contents of a document, locate numbers with a checksum, check if the checksum is correct, then highlight or format the text to indicate correct/incorrect.

For those that are new to the concept of checksums I'll explain it. Please bear in mind I dont mean for this to sound condecending at all. If you know how checksums work you can skip this example.

Example: We'll use a time in Zulu.

170006Z4 FEB 18

That shows the 17th day of Feb 2018. The checksum "4" after the "Z" (indicating the time zone) is calculated by adding all the numbers up and using the number that shows in the ones place.

1 + 7 + 0 + 0 + 0 + 6 = 14

1 (ten's place) 4 (one's place)

We drop everything but the one's place and add it after the time zone.

This is the code I'm working with but I'm not really familar with the .find function and the documentation is a bit confusing on it. This only highlights the first item green and the rest of them red from the example below. I can't figure out why. This is only one type of number I'm looking to check.

The output I'm getting:
122323z3
122323z1
122323z8
010000Z1
122323z2

What I expected:
122323z3
122323z1
122323z8
010000Z1
122323z2

Sub Verify_Checksums()


Dim TargetItem As String
Dim CheckSum As Long
Dim NumberSum As Long
Dim Value As String
Dim i As Long


    With Selection
        
        .HomeKey wdStory


        With .Find
            
            .ClearFormatting
            .Text = "[0-9]{6}[A-Za-z]{1}[0-9]{1}"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            'MUST USE WILDCARDS OR IT DOESN'T WORK
            .MatchWildcards = True
        
        End With
        
        While .Find.Execute
   
            'Verify checksum
            Value = .Text
            TargetItem = .Text
            CheckSum = Right(TargetItem, 1)
            
            For i = 0 To Len(TargetItem) - 3
            NumberSum = NumberSum + Left(TargetItem, 1)
            TargetItem = Right(TargetItem, Len(TargetItem) - 1)
            Next i
    
            NumberSum = Right(NumberSum, 1)
    
            If NumberSum = CheckSum Then
                'MATH EQUALS THE CHECKSUM LET HIGHLIGHT IT GREEN
                .Text = Value
                .Font.Color = wdColorGreen
                            
            Else
                'MUST BE WRONG SO LETS HIGHLIGHT IT RED
                .Text = Value
                .Font.Color = wdColorRed
            
            End If
      
        Wend


    End With


End Sub

END PRODUCT: What i'm trying to do is check a list of formats and verify the checksums, but I dont mind just using copy and paste and just change the target text and run more then one operation in a row. In the end I'll be checking for these formats

The "0" indicates numbers, "X" indicates letters, and "/" indicates the symbol "/"
0/0
00/0
00000/0

0X0
00X0
000X0
0000X0
00000X0
000000X0 <----- This is the most common format so I'm using this for my testing.
0000000X0

Any help with this would be wonderful. I'm going to keep plugging away trying to figure this out.

Thanks!

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9]@[A-Za-z][0-9]"
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    j = 0: k = k + 1
    For i = 1 To Len(.Text) - 2
      j = j + Mid(.Text, i, 1)
    Next
      j = j Mod 10
    If Right(.Text, 1) = j Then
      .Font.ColorIndex = wdGreen
    Else
      .Font.ColorIndex = wdRed
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox k & " instances found."
End Sub

Given your specs, this should work for any length string.

[gmaxey]

Paul,

Nothing new here other than adding the condition for the standard checksum delimiter.

Sub Demo()
Dim i As Long, j As Long, k As Long
Dim oRng As Range
  Application.ScreenUpdating = False
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9]@[AZ-az//][0-9]" 'Modified to handled the "/" checksum delimiter.
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    While .Execute
      j = 0: k = k + 1
      For i = 1 To Len(oRng.Text) - 2
        j = j + Mid(oRng.Text, i, 1)
      Next
      j = j Mod 10
      If Right(oRng.Text, 1) = j Then
        oRng.Font.ColorIndex = wdGreen
      Else
        oRng.Font.ColorIndex = wdRed
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
  MsgBox k & " instances found."
End Sub

[macropod]

Thanks Greg, I missed that.

[Carson]

Paul & Greg,

Thank you. That worked perfectly. I code VB on a regular basis. I didn't think it would be that hard to use the .find feature like this. Now I'm going to dig around and learn more about it. Maybe switch the font color to a highlight, not sure yet.

Again thank you!

[Carson]

I did run in to one small setback. when it goes though the document I have some lat & lon values written out like this

/2134N0-01257W5/2134N0-01257W5/5134N0-01257W5/

when I run the maco it results in this

/2134N0-01257W5/2134N0-01257W5/5134N0-01257W5/

There are instances where I will get lat & lon formated like this also:

/213400N0-0125700W5/213400N0-0125700W5/513400N0-0125700W5/

I thought it might be due to the "//" in the ".text =" but it didn't resolve the problem when I removed it. I'm pretty sure I'll have to add another instance of the sub to cover those. Its probably happening because of the "-". It never crossed my mind it could cause a problem. I figured I'd post this here to get your advice on how to resolve it. I'm going to copy the sub and attempt to resolve it with another pass looking for just that.

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[0-9]@[A-Za-z//][0-9]>"
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    j = 0: k = k + 1
    For i = 1 To Len(.Text) - 2
      j = j + Mid(.Text, i, 1)
    Next
      j = j Mod 10
    If Right(.Text, 1) = j Then
      .Font.ColorIndex = wdGreen
    Else
      .Font.ColorIndex = wdRed
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox k & " instances found."
End Sub

[Carson]

Hmm, still gave the same results.

"/2134N0-01257W5/2134N0-01257W5/5134N0-01257W5/"

I've also tried defining the string of text like this:
"[0-9]{4}[A-Za-z//]{1}[0-9]{1}[--]{1}[0-9]{5}[A-Za-z//]{1}[0-9]{1}"

Then this: (Not sure why its split like that, I've tried to delete the extra "CODE" sections and it wont go away)

Dim i As Long, i2 As Long, j As Long, K As Long, L As Long
Dim a As String, b As String

//Find function here...

Do While ...
    a = Left(.text, 6)
    b = Right(.text, 7)
    For i = 1 to Len(a) - 2
        j = j + mid(a, i , 1)
    Next
        j = j Mod 10

   For i2 = 1 to Len(b) - 2
        l = l + mid(b, i , 1)
    Next
        l = l Mod 10
    If Right(a, 1) = j Then
        If Right(b, 1) = l Then
            .Font.ColorIndex = wdGreen
        End If
    Else
        .Font.ColorIndex = wdRed
    End If

//Code Doesn't Change Past Here.

That didnt work either. This is an example of a full line that its searching incase it will help.

AREA/ONE/2134N0-01257W5/2134N0-01257W5/5134N0-01257W5/
/2134N0-01257W5/2134N0-01257W5/5134N0-01257W5//
AREA/TWO/213400N0-0125700W5/213400N0-0125700W5/
513400N0-0125700W5/513400N0-0125700W5//

I'll keep plugging away. I'll post if I find a solution.

[Carson]

I take that back, I was dumb and typed it in wrong. It your code worked flawlessly. I can't use copy and paste for the code because the computer im working on is on a isolated network. Chalk it up to human error lol.

Thank you again for your help.