Is there a way to identify if a worksheet has a highlighted cell at a worksheet level, without checking all the cells?

Question

Is there a way to identify if a worksheet has a highlighted cell at a worksheet level, without checking all the cells?

Further context: I have a WorkBook with a number of Worksheets(ws). some of the worksheets have cells that are highlighted. I want to be able to take out the worksheets that have a cell highlighted and put them in another workbook. But the way I do it is, I go through each cell in each worksheet to find a highlighted cell, and when I find one, I copy this worksheet to another workbook and move on to the next work sheet. But the more ws there are the longer this takes and because I have to go through individual cells. So my questions is, Is there a way to identify if a worksheet has a highlighted cell at a worksheet level? Or do I have to go through each cell range in each worksheet?

Code

' copy the path from cell a1 to the master in a1, a2, a3.....
' want to add to copy the WS if it has a highlighted area
' added copy ws with highlight to new WB and exit for loop for checking more highlighted areas
' this works C:\Samsung\Macros\test_macro_test3.xlsm, see cloumn A in master sheet and have Summary.xlsm WB open

Sub test3()

Dim startTime, endTime As Date
startTime = Now

Dim ws As Worksheet, MainWs As Worksheet, cell As Range
Set MainWs = Sheets("master") '<-- change name as needed
Dim i As Integer
i = 1
For Each ws In Sheets
   If ws.Name <> MainWs.Name Then
      For Each cell In ws.UsedRange
        Debug.Print "ws.Name:" & ws.Name
        Debug.Print "cell.Address:" & cell.Address
        Debug.Print "cell.Value:" & cell.Value
        Debug.Print "i:" & i
        
         'if your cells are colored through conditional formatting, delete/comment below line & uncomment the line after
         If cell.Interior.Color = vbYellow Then
            MainWs.Range("A" & i) = ws.Range("A1").Value
            MainWs.Range("B" & i) = ws.Name
            ws.Copy After:=Workbooks("Summary.xlsm").Sheets(Workbooks("Summary.xlsm").Sheets.Count)
            Exit For
            'If cell.DisplayFormat.Interior.Color = vbYellow Then MainWs.Range(cell.Address) = cell.Value
            Debug.Print "cell.Address:" & cell.Address
            Debug.Print "cell.Value:" & cell.Value
            Debug.Print "i:" & i
            Exit For
        End If
      Next
   End If
   i = i + 1
Next 'next worksheet


endTime = Now

Debug.Print "startTime:" & startTime
Debug.Print "endTime:  " & endTime
Debug.Print "Total(hh:mm:ss)" & Format((DateDiff("s", startTime, endTime)) / 86400, "hh:mm:ss")
    
End Sub

WB examples

https://www.dropbox.com/scl/fi/7x91vwbvv62nn15loczpy/test_macro_test3.xlsm?dl=0&rlkey=k8b53wizejaf4jqwjzilthvg2

https://www.dropbox.com/scl/fi/8c5uatqyhlwlv5pzcude7/Summary.xlsm?dl=0&rlkey=fodf1j7ic7ac5pl9coehnlhab

Answer 1

You can use the following function to check if a worksheet has cells with a certain background color:

Public Function hasSheetHighlightedCells(ws As Worksheet, _
                                         Optional lngColor As Long = vbYellow) As Boolean

Application.FindFormat.Clear
Application.FindFormat.Interior.color = lngColor

Dim rgFound As Range
On Error Resume Next 'in case nothing can be found
Set rgFound = ws.UsedRange.Find("*", searchFormat:=True)


On Error GoTo 0
If Not rgFound Is Nothing Then
    hasSheetHighlightedCells = True
End If

Application.FindFormat.Clear

End Function

You will call that function within your For each ws in Sheets loop:

If hasSheetHighlightedCells(ws) = true then

This will check for the default color vbYellow. If you want to check for a different color you can use e.g. If hasSheetHighlightedCells(ws, vbRed) = true then