Move Selection to the next Column on a Page (Not a table)

[GuitarForLife]

Hi, Ive written some code which changes the colour of certain selected text.
The page of each document has either one or two columns. The documents are only one page long.
The code works beautifully as it moves down the first column of text, but wont move up to the top of the second column to start editing that piece of text.
I cant find any code that identifies the number of columns, and then moves the selection from the bottom of the first column (when it gets there), to the top of the second column so it can start the process again.



Appreciate your help!

Here is my code:

Sub ColourText()
Dim numOfLines As Integer
Dim numOfColumns As Integer
Dim numOfSpaces As Integer
Dim numOfChar As Integer
Dim ArraySpaces() As String
Dim x1 As Integer


'Count the number of non blank lines in current document
numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")


'Move to start of document
Selection.HomeKey Unit:=wdStory

'Start the loop - looping once for each line
For x1 = 1 To numOfLines

'Move to start of line
Selection.HomeKey Unit:=wdLine

'Select entire line
Selection.EndKey Unit:=wdLine, Extend:=wdExtend


If Len(Selection.Range.Text) > 1 Then 'if 1 ignore as paragraph return only

'check to see if current line is likely to be Chords - ie if it contains lots of spaces
ArraySpaces = Split(Selection.Range.Text, " ")
numOfSpaces = UBound(ArraySpaces)

'count characters in selection
numOfChar = Len(Selection.Range.Text) - numOfSpaces

If (numOfSpaces > numOfChar) Or numOfChar < 4 Then ' likely not to be text so should be chords
'colour this line blue
Selection.Font.TextColor.RGB = RGB(0, 0, 255)
Else 'colour this line black
Selection.Font.TextColor.RGB = RGB(0, 0, 0)
End If
End If

If InStr(1, Selection.Range.Text, "Chorus") Then
Selection.Range.HighlightColorIndex = wdYellow
Selection.Font.Bold = True
End If

'Move to the next part of the loop ##but wont do this when more than 1 column of text

Selection.MoveDown Unit:=wdLine, count:=1

Next x1

MsgBox ("Setup completed")

End Sub