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

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:

Code:

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.

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.

Code:

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

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.

Quote:

Originally Posted by vkhu

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.

I just found this thread discussing a somewhat similar issue 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:

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?

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.

Code:

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

Thanks, I'm gonna try it out.