Make Unit:=wdWord ignores punctuations, special characters, and numbers

[vkhu]

Hi, I'm making a macro in word that will skip ahead a certain amount of words, then mark the place so I'll know where each section ends. The code is like so:

Sub QuotaWordHighlight()
On Error GoTo ErrorReport
' Cancel macro when no word is defined
Dim NoWord As Integer
' The number of word to jump
Dim NoWord2 As Integer
' The number of word to jump
Dim Msg As String
' This is what to display on the dialog box

PlayTheSound "W21 - Go Ahead TACCOM.wav"
Msg = "How many words do you want to do first?"
NoWord = InputBox(Msg)
Msg = "And then?"
NoWord2 = InputBox(Msg)
' How the variables are defined
Application.DisplayAlerts = False
PlayTheSound "W22 - Confirmed.wav"

Do Until ActiveDocument.Bookmarks("\Sel").Range.End = ActiveDocument.Bookmarks("\EndOfDoc").Range.End


Selection.MoveRight Unit:=wdWord, Count:=NoWord + 1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Color = RGB(0, 60, 179)

Selection.MoveRight Unit:=wdWord, Count:=NoWord2 + 1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Color = RGB(0, 60, 179)


Loop
' Searching the remaning (till the end of document)
PlayTheSound "W23 - Target Designated.wav"

ErrorReport:


End Sub

The problem is every single special character or number is recognized as a separate word. This means if, for example, I tell it to mark ahead every 50 words, sometimes I'll get a section with 41, sometimes 37, sometimes 46, and so on.

Is there a way to specify that if encounter such and such word, add 1 to the word count ("NoWord" and "NoWord2") and keep going?

EDIT: for those who are curious, this macro is to help me mark my translation quota each day. Say I plan to do 2,000 words a day, I would input "2000" into the text box (the text box will ask me twice about the number of words because sometimes my schedule force me to alternate my quota, such as 1,500 and 2,000 words each day, alternately), and every 2,000 words, there will be a part with blue letters, telling me once I've done translating up to that point, I can stop for the day.

[gmayor]

I am not sure what your macro is supposed to do as it seems to simply turn the text blue from the start point.

The particular problem you complain of is that what you think of as a word and what VBA accepts as a word are not the same thing. If you want to select a number of words from the start point, then the following may be nearer to what you had in mind. It will ignore words that are not 'words' and colour those that are blue.


Sub Macro1()
Dim oRng As Range
Dim i As Long, j As Long
j = InputBox("How many words?")
i = 0
Set oRng = Selection.Range
oRng.Collapse 1
oRng.End = ActiveDocument.Range.End
With oRng.Find
Do While .Execute(FindText:="<[a-zA-Z]{1,}>", MatchWildcards:=True)
i = i + 1
oRng.Font.Color = RGB(0, 60, 179)
oRng.Collapse 0
If i = j Then Exit Do
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[vkhu]

Perhaps it will be better if I explain what I'm trying to do:

I'm a freelance translator, and I made this macro to help me mark my translation quota each day. Say I plan to do 2,000 words a day, I would input "2000" into the text box (the text box will ask me twice about the number of words because sometimes my schedule force me to alternate my quota, such as 1,500 and 2,000 words each day, alternately), and every 2,000 words, there will be a part with blue letters, telling me once I've done translating up to that point, I can stop for the day.

I hope that clear things up.

P/S: The solution you suggested isn't suited for my purpose. It simply colors every word blue, not marking the end of each section where I can stop translating for the day.

[macropod]

P/S: The solution you suggested isn't suited for my purpose. It simply colors every word blue, not marking the end of each section where I can stop translating for the day.
Well, that's another whole can of words. VBA has no idea what a grammatical sentence is. Consider the following:
Mr. Smith spent $1,234.56 at Dr. John's Grocery Store, to buy: 10.25kg of potatoes; 10kg of avocados; and 15.1kg of Mrs. Green's Mt. Pleasant macadamia nuts.
For you and me, that would count as one sentence; for VBA it counts as 5 sentences.

[vkhu]

I just found this thread discussing a somewhat similar issue (https://stackoverflow.com/questions/25556547/issue-selecting-a-specific-amount-of-words-in-ms-word?rq=1) today and tried to adapt it to my code. However, when my code run, it got stuck in an infinite loop. Here's the new code:


Sub QuotaWordHighlight() Const punctuation As String = ",./;'\1234567890-` =?:|~!@#$%^&*()_+" '<~~ Modify as needed with additional marks
Dim wCount As Long
Dim selectedWords As Range
On Error GoTo ErrorReport
' Cancel macro when no word is defined
Dim NoWord As Integer
' The number of word to jump
Dim Msg As String
' This is what to display on the dialog box

PlayTheSound "W21 - Go Ahead TACCOM.wav"
Msg = "How many words do you want to do per day?"
NoWord = InputBox(Msg)
Application.DisplayAlerts = False
PlayTheSound "W22 - Confirmed.wav"

Do Until ActiveDocument.Bookmarks("\Sel").Range.End = ActiveDocument.Bookmarks("\EndOfDoc").Range.End

Do
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Set selectedWords = Selection.Range
With selectedWords
If InStr(1, punctuation, RTrim(.Words(.Words.Count))) = 0 Then wCount = wCount + 1
End With
Loop While wCount < NoWord
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Color = RGB(0, 60, 179)

Loop
' Searching the remaning (till the end of document)
PlayTheSound "W23 - Target Designated.wav"

ErrorReport:

End Sub
Does anyone knows where the problem lies and how to fix it?

[macropod]

Try something based on the following macro I wrote for another purpose; it inserts page breaks at the ends of VBA 'sentences' following the specified word counts.

Sub Splitter()
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
Set Rng = .Range(0, 0): j = CLng(InputBox("How many words?", , 2000))
For i = 1 To Int(.ComputeStatistics(wdStatisticWords) / j)
With Rng
.MoveEnd wdWord, j
Do While .ComputeStatistics(wdStatisticWords) Mod j <> 0
.MoveEnd wdWord, j - .ComputeStatistics(wdStatisticWords) Mod j
Loop
.End = .Sentences.Last.End
.Collapse wdCollapseEnd
.InsertBreak Type:=wdPageBreak
.Collapse wdCollapseEnd
End With
Next
End With
End Sub

[vkhu]

Thanks, I'm gonna try it out.