Sub WhyDoesntItFindAct2035b()
'2/22/2023
'The 1st sheet "Act" contains several verses in the book of Acts that are color formatted.
'I'm trying to find all verses with at least one red letter in them.
'These are the verses with any red letters: 18:9-10 20:35 22:7-8,10,18,21 23:11 26:14-18
'It only finds 18:10 26:16-18  Why?  Is there any way to make it find the others using range.find?
Dim C As Range, WrkBk As Workbook, Ctr As Long, HitColor As Variant, StRng As String
Dim NumOccur As Long, N As Long, StartTime As Double, AdjWrd As String
Dim AC As Range, lenACary As Long, cc As Range, ACary() As Variant, chRef As String
Dim Ctrstart As Long, Ctrstop As Long, FirstAddress As String
Dim BookSht As Worksheet, RsltSht As Worksheet, ByBook As Variant
Dim NumCols As Long, M As Long
Dim SrchWrd As String
Dim SrchColor As Boolean
Dim SrchStr As String, MtchCase As Boolean
Dim cbOnlyRed As Boolean
Dim cll As Range, I

MtchCase = False
cbOnlyRed = True
If MtchCase Then
  iMtchCase = vbBinaryCompare
Else
  iMtchCase = vbTextCompare
End If
SrchColor = cbOnlyRed                            'False 'True '
NumCols = 7
lenACary = 0
ReDim ACary(NumCols, lenACary)
Set WrkBk = ActiveWorkbook
Ctrstart = WrkBk.Sheets(1).Index
Ctrstop = WrkBk.Sheets(1).Index
StRng = "B1"                                     'start range
ByBook = 2
Set RsltSht = WrkBk.Sheets("Results")
StartTime = Timer
For Ctr = Ctrstart To Ctrstop
  Set BookSht = WrkBk.Sheets(Ctr)
  BookSht.Activate
  Set cc = BookSht.Range(Range(StRng), Range(StRng).End(xlDown))


   

   For Each cll In cc.Cells
    Set C = Nothing
    For I = 1 To cll.Characters.Count
      If cll.Characters(I, 1).Font.Color = RedLetterColor Then
        Set C = cll
        Exit For
      End If
    Next I
    If Not C Is Nothing Then
      chRef = GetRef(BookSht.Cells(C.Row, 1), ByBook)
      NumOccur = 0
      Call UpdateOutputArray(ACary, chRef, lenACary, NumCols, SrchWrd, AdjWrd, NumOccur, ByBook, C)
    End If
  Next cll




Next Ctr
 RsltSht.Activate
RsltSht.Cells.ClearContents
RsltSht.Cells.ClearFormats
ACary = TransposeArray(ACary)

Set AC = RsltSht.Range(Cells(1, 1), Cells(lenACary + 1, NumCols))
AC.Value = ACary
AC.Sort AC.Columns(1), xlAscending, AC.Columns(2), , xlAscending
Call VrsFill(AC)
AC.Columns(2).ClearContents
For N = 1 To AC.Rows.Count - 1
  AC.Cells(N, 2) = N
Next N
TglWrdWrpCol
Debug.Print "done WhyDoesntItFindAct2035b  " & Format((Timer - StartTime) / 60, "##0.00") & " min.  " & Time
End Sub