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.