Microsoft Office Forums - View Single Post

gmaxey · 06-16-2025, 10:06 AM

Not much activity here any more, so I thought I would try to spark some interest/get comments on some code that I was tinkering with the other day.

There is a post in the Microsoft forums where the users wants (or at least seems to want) a process to find and select each instance of text with the font formatted various different colors e.g., the old standard red (255) and the new standard red (238). As the segments of formatted text might be mixed throughout the document e.g., XXX 255 XXX XXX 238 XXX XXX 255 etc., ideally it would be selected and evaluated serially through the document (not in two separate loops).

Redirecting

I posted something in reply that worked but it was a bit clunky and I didn't get a reply. This morning I decided to improve that process by using a Collection to gather the range start and end points then sort and loop through that collection:

Code:

Sub EvaluateTextByFontColor()
Dim oCol As New Collection
Dim oRng As Range
Dim lngIndex As Long
Dim varParts As Variant
Dim arrColors() As String
  arrColors = Split("238|255|49407", "|")
  For lngIndex = 0 To UBound(arrColors)
    Set oRng = ActiveDocument.Range
    'Find all instances of text formated RGB 238, 255 and 49407
    With oRng.Find
      .Font.TextColor.RGB = arrColors(lngIndex)
       While .Execute
         oCol.Add oRng.Start & "|" & oRng.End
         oRng.Collapse wdCollapseEnd
       Wend
    End With
  Next lngIndex
  fcnSortColumn oCol
  'Loop through collection of ranges to evaluate.
  For lngIndex = 1 To oCol.Count
    varParts = Split(oCol(lngIndex), "|")
    ActiveDocument.Range(varParts(0), varParts(1)).Select
    If MsgBox("Convert to black?", vbQuestion + vbYesNo, "CONVERT") = vbYes Then
      Selection.Font.TextColor = wdColorBlack
    End If
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub
Public Function fcnSortColumn(ByVal oColPassed As Collection) As Collection
Dim lngA As Long, lngB As Long
Dim vOld As Variant
Dim varP1 As Variant, varP2 As Variant
  For lngA = 1 To oColPassed.Count - 1
    varP1 = Split(oColPassed(lngA), "|")(0)
    For lngB = lngA + 1 To oColPassed.Count
      varP2 = Split(oColPassed(lngB), "|")(0)
      If varP1 > varP2 Then
        vOld = oColPassed(lngB)
        oColPassed.Remove lngB
        oColPassed.Add vOld, vOld, lngA
      End If
    Next lngB
  Next lngA
  Set fcnSortColumn = oColPassed
lbl_Exit:
  Exit Function
End Function

Anyone see room for improvement?