Microsoft Office Forums - View Single Post - [Solved] Move Selection to the next Column on a Page (Not a table)

macropod · 02-09-2018, 01:59 PM

IMHO, this would be a lot simpler if you used Styles for the formatting. As far as I can tell, too, you don't need any complicated arrays. Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTmp As String: Const StrAcc As String = "m7#b"
On Error Resume Next
With ActiveDocument
  .Styles.Add "Chord", wdStyleTypeParagraph 'wdStyleTypeCharacter
  .Styles("Chord").Font.ColorIndex = wdBlue
End With
On Error GoTo 0
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-F][m7#b ^13]"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Paragraphs(1).Style = "Chord" Then
      .End = .Paragraphs(1).Range.End
    Else
      StrTmp = Split(.Paragraphs(1).Range.Text, vbCr)(0)
      For i = 1 To Len(StrAcc)
        StrTmp = Replace(StrTmp, Mid(StrAcc, i, 1), "")
      Next
      For i = 1 To 7
        StrTmp = Replace(StrTmp, Chr(64 + i), "")
      Next
      StrTmp = Trim(StrTmp)
      If StrTmp = "" Then .Paragraphs(1).Style = "Chord"
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "\[[!\[]@\]"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
      Select Case .Text
        Case "[Chorus]": .HighlightColorIndex = wdYellow: .Style = wdStyleStrong
        Case "[Verse]": .HighlightColorIndex = wdNoHighlight: .Font.Reset
        Case "[Bridge]": .HighlightColorIndex = wdBrightGreen: .Style = wdStyleStrong
      End Select
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub