Sub ColourText2()
Dim numOfLines As Integer
Dim numOfColumns As Integer
Dim numOfSpaces As Integer
Dim numOfChar As Integer
Dim ArraySpaces() As String
Dim x1 As Integer
With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=1
        .EvenlySpaced = True
        .LineBetween = False
End With

'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
Selection.WholeStory
'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
'Selection.Columns.Select
Next x1
With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
        .Width = InchesToPoints(3.49)
End With
MsgBox ("Setup completed. Rock on Bud!")
End Sub