Microsoft Word VBA moving through paragraphs and highlighting specific positions in each paragraph

Question

I am trying to move through each line or paragraph and highlight a specific range of text within the text document the variable intSortPos is an array of integers that hold the start position and the amount of position after the start position to hightlight for example intSortPos(0) is the start position and intSortPos(1) is the amount of spaces to move from intSortPos(0)

When I run this code it only highlights the first line although I can see in the debugger that it is setting the range to other paragraphs although it is not changing them like it should be.

 Public Sub Highlight()
 Dim para As Paragraph
 Dim i As Integer
 Dim j As Integer
 Dim rng As Range
 Dim rngGray As Range
 Dim start As Integer
 Dim move As Integer

 start = 0
 move = 1

 For Each para In ActiveDocument.Paragraphs

   'MsgBox (">" & para.Range.Text)

    Set rng = para.Range
    rng.SetRange start:=intSortPos(start), End:=intSortPos(start) + intSortPos(move)
    rng.HighlightColorIndex = wdYellow
    'start = start + 2
    'move = move + 2


 Next para
End Sub

Answer 1

rng.SetRange start:=0, End:1 means the first character in the whole document, not in the paragraph. So when setting the range start you have to use rng.SetRange start:=rng.Start .

I've modified your code to highlight first 10 characters in every paragraph:

    Option Explicit

    Public Sub Highlight()

     Dim para As Paragraph
     Dim i As Integer
     Dim j As Integer
     Dim rng As Range
     Dim rngGray As Range
     Dim move As Integer

     Dim startHighlight As Integer
     Dim endHighlight As Integer

     For Each para In ActiveDocument.Paragraphs

        Set rng = para.Range
        startHighlight = rng.start
        endHighlight = rng.start + 10
        rng.SetRange start:=startHighlight, End:=endHighlight
        rng.HighlightColorIndex = wdYellow

     Next para

    End Sub

Hope it helps.

Answer 2

Here is the working code for highlighting specific areas within a paragraph I use what is called a Sort Card to decide where the highlights will be. The sort card is pasted into the document along with the data before the macro is ran. Here is what my sort card looks like

Sort Fields=(30,4,CH,A,5,12,CH,A,17,13,CH,A,3,2,CH,A)

30 being the first start position and 4 being the amount of spaces from that position. The next highlight position is 5 and the amount of spaces we are highlight for is 12. This just goes on for as long as the sort card is.

Public Sub SetPositions()

    Dim myRange As Object
    Dim i As Integer
    Dim strSortCard As String
    Dim Char As Variant
    Dim Char2 As Variant
    Dim blNumeric As Boolean
    Dim blNumeric2 As Boolean

    Dim intDoubleDigit As Integer

    Set myRange = ActiveDocument.Range

    selection.ClearFormatting
    selection.MoveUp Unit:=wdScreen, count:=1

    With ActiveDocument.Content.Find
        .Text = "Sort Fields=("
        .Forward = True
        .Execute
        If .Found = True Then .Parent.Bold = True
    End With

    'selection.MoveRight Unit:=wdCharacter, count:=1

    'selection.SetRange Start:=5, End:=6
    selection.Expand wdLine
    strSortCard = selection.Text
    strSortCard = RTrim(strSortCard)

    ReDim intSortPos(16)

    For i = 1 To Len(strSortCard)
        Char = Mid(strSortCard, i, 1)
        blNumeric = IsNumeric(Char)
        'if is numeric
        If (blNumeric) Then
            blNumeric = False
            'check the next char for a number
            Char2 = Mid(strSortCard, i + 1, 1)
            blNumeric2 = IsNumeric(Char2)
            If (blNumeric2) Then
                blNumeric2 = False
                intDoubleDigit = CInt(Char) & CInt(Char2)
                intSortPos(intCountPos) = CInt(intDoubleDigit)
                'MsgBox (intSortPos(intCountPos))
                i = i + 1
            Else
                intSortPos(intCountPos) = CInt(Char)
                'MsgBox (intSortPos(intCountPos))
            End If
            intCountPos = intCountPos + 1
        End If
    Next


    'For i = 0 To 7
        'MsgBox (intSortPos(i))
    'Next
    Call Highlight

End Sub


Public Sub Highlight()
Dim para As Paragraph
Dim i As Integer
Dim j As Integer
Dim rng As Range
Dim rngGray As Range
Dim start As Integer
Dim move As Integer
Dim startHighlight As Integer
Dim endHighlight As Integer
Dim intParaStart As Integer
Dim blFirstline As Boolean

start = 0
move = 1
blFirstline = True
For Each para In ActiveDocument.Paragraphs

If blFirstline Then
    para.Next
    blFirstline = False
End If

    'MsgBox (">" & para.Range.Text)

    selection.Find.ClearFormatting
    Set rng = para.Range
    'rng.start = intSortPos(start)
    startHighlight = rng.start + intSortPos(start + 0) - 1
    endHighlight = startHighlight + intSortPos(move + 0)


    rng.SetRange start:=startHighlight, End:=endHighlight
    rng.HighlightColorIndex = wdYellow


    Set rng = para.Range

    startHighlight = rng.start + intSortPos(start + 2) - 1
    endHighlight = startHighlight + intSortPos(move + 2)

    rng.SetRange start:=startHighlight, End:=endHighlight
    rng.HighlightColorIndex = wdBlue

    Set rng = para.Range

    startHighlight = rng.start + intSortPos(start + 4) - 1
    endHighlight = startHighlight + intSortPos(move + 4)

    rng.SetRange start:=startHighlight, End:=endHighlight
    rng.HighlightColorIndex = wdRed

    Set rng = para.Range

    startHighlight = rng.start + intSortPos(start + 6) - 1
    endHighlight = startHighlight + intSortPos(move + 6)

    rng.SetRange start:=startHighlight, End:=endHighlight
    rng.HighlightColorIndex = wdViolet

Next para