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 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.