Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-22-2024, 01:42 PM
brelin brelin is offline range.find searchformat doesn't find all cells with any red font Windows 10 range.find searchformat doesn't find all cells with any red font Office 2010
Novice
range.find searchformat doesn't find all cells with any red font
 
Join Date: Nov 2024
Posts: 1
brelin is on a distinguished road
Default range.find searchformat doesn't find all cells with any red font

In the attached xlsm WhyDoesntItFindAct2035 doesn't find the red font in the Act sheet B97. Even if I remove all but the red font from that cell it still won't find it. Any ideas?
Attached Files
File Type: xlsm rangefind searchformat doesnt work.xlsm (167.9 KB, 5 views)
Reply With Quote
  #2  
Old 11-22-2024, 08:48 PM
macropod's Avatar
macropod macropod is online now range.find searchformat doesn't find all cells with any red font Windows 10 range.find searchformat doesn't find all cells with any red font Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,366
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

If you look at the captured records, you'll see they all start with something red. If I copy one of those cells to B97, the macro finds it.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 11-23-2024, 06:23 AM
p45cal's Avatar
p45cal p45cal is offline range.find searchformat doesn't find all cells with any red font Windows 10 range.find searchformat doesn't find all cells with any red font Office 2021
Expert
 
Join Date: Apr 2014
Posts: 947
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

I tried changing to
SrchStr = "?"
being a wildcard single character and got some success but it was very unreliable and caused Excel to hang (macro appeared to be running forever) occasionally. So I gave up and resorted to checking each cell character by character.
Try this (there are now several unused variables - I'll leave you to clear that up):
Code:
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
It's a lot slower (more than a minute here on your data).
Reply With Quote
  #4  
Old 11-23-2024, 03:12 PM
macropod's Avatar
macropod macropod is online now range.find searchformat doesn't find all cells with any red font Windows 10 range.find searchformat doesn't find all cells with any red font Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,366
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Personally, I'd be inclined to do all this in Word - even automating it from Excel as per the code below if you need the results in Excel. Makes for much simpler code, too:
Code:
Sub GetRedData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim WkSht1 As Worksheet, WkSht2 As Worksheet, r As Long, x As Long
Set WkSht1 = ThisWorkbook.Sheets("Act"): Set WkSht2 = ThisWorkbook.Sheets("Results")
Dim wdApp As New Word.Application, wdDoc As Word.Document
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Add: WkSht1.UsedRange.Copy
  With wdDoc
    With .Range
      .PasteExcelTable False, False, False
      With .Find
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .Font.Color = 3618778
      End With
      Do While .Find.Execute
        r = .Cells(1).RowIndex: x = x + 1
        With WkSht2
          .Range("B" & x).Value = x: .Range("C" & x).Value = r
          .Range("D" & x).Value = WkSht1.Range("A" & r).Value
          WkSht1.Range("B" & r).Copy
          .Paste Destination:=.Range("F" & x)
        End With
        .Start = .Cells(1).Range.End + 1
      Loop
      
    End With
    .Close SaveChanges:=False
  End With
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht1 = Nothing: Set WkSht2 = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Tags
searchformat



Similar Threads
Thread Thread Starter Forum Replies Last Post
range.find searchformat doesn't find all cells with any red font Range method Find can't find dates jmcsa3 Excel Programming 1 05-02-2020 06:56 AM
range.find searchformat doesn't find all cells with any red font Find if Date range falls within another range Triadragon Excel 3 05-02-2016 11:48 AM
Find a Date in a Range rspiet Excel 3 02-15-2016 08:37 AM
find IP in range / find number between numbers gn28 Excel 4 06-14-2015 03:46 PM
range.find searchformat doesn't find all cells with any red font Find and Replace doesn't work. Bop70 Word 3 02-04-2015 11:45 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:34 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft