Find Cell Based only on Format

user_13344757 0
Viewed 47

I'm trying to iterate through worksheets and find cells that have a font size of 22. Here is what I have so far, however I keep returning the value of the first found term over and over again as it iterates through the sheets. I'm assuming I'll need to incorporate a FindNext in there somewhere?

Sub FindFormatCell()

Dim ws As Worksheet
Dim rngFound As Range

With Application.FindFormat.Font
        .Size = 22
End With

For Each ws In Worksheets
    If ws.Tab.ColorIndex = 20 And ws.Visible = xlSheetVisible Then
        Set rngFound = Cells.Find(What:="", SearchFormat:=True)
        Debug.Print rngFound
    End If
Next ws
        
Application.FindFormat.Clear

End Sub
vba excel
1 Answers

The Find Method - A SearchFormat Search

Option Explicit

Sub FindFormatCell()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Application.FindFormat.Font.Size = 22
    
    Dim ws As Worksheet
    Dim sCell As Range
    Dim srg As Range
    Dim urg As Range
    Dim FirstAddress As String
    
    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetVisible And ws.Tab.ColorIndex = 20 Then
            Set srg = ws.UsedRange
            ' "" - empty cells, "*" - occupied cells
            Set sCell = srg.Find(What:="", _
                After:=srg.Cells(srg.Rows.Count, srg.Columns.Count), _
                LookIn:=xlValues, SearchOrder:=xlByRows, SearchFormat:=True)
            If Not sCell Is Nothing Then
                FirstAddress = sCell.Address
                Do
                    If urg Is Nothing Then
                        Set urg = sCell
                    Else
                        Set urg = Union(urg, sCell)
                    End If
                    Set sCell = srg.FindNext(sCell)
                Loop Until sCell.Address = FirstAddress
            End If
            If Not urg Is Nothing Then
                ' Start doing stuff here.
                
                Debug.Print ws.Name, urg.Address(0, 0)
                            
                ' End doing stuff here.
                Set urg = Nothing
            End If
        End If
    Next ws
            
    Application.FindFormat.Clear

End Sub
user_98140690
Related