FindFormat ColorIndex Then Make A List

[cwhite86]

Thanks to all who have helped this little project of mine get this far!


Next step -

Generate a list of all the cells with a given interior color

Two Lists are needed

The first list will search for anything red on a single Sheet "INVMaster" and paste the cell contents in a list form

The second will search for anything red on 17 other sheets (though in this example I only included 2) and make a single list of the red cells found.


Right now i have been researching on it and I read that .Find won't work, that I need .FindFormat

You guys have any ideas?

[LJMetzger]

Hi cwhite86,

I tend to write code that is verbose. The following code works for me. There are working copies of the code in the attached file which I refer to quite often.

Please note that .find is very particular about the inputs:
a. ws.Cells.Find and ws.Range MUST refer to the same sheet.
b. In the 'FindNext' example, ws.Columns("C") and After:=ws.Range("C1") must Match (e.g. Column 'C').

Function LjmFindRedCells(ws As Worksheet, sFindString As String) As Long
  'This iterates through a worksheet finding all the occurences of a 'format'
  'NOTE: A format and a value can be found at the same time
  
  Dim r As Range
  Dim iCount As Long
  Dim bNeedMore As Boolean
  Dim sAddress As String
  Dim sFirstAddress As String
  
  'Set the 'Format' being searched for
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = RGB(255, 0, 0)

  'Find the first occurence of the 'Format'
  Set r = Nothing
  Set r = ws.Cells.Find(What:=sFindString, _
                      After:=ws.Range("A1"), _
                      LookIn:=xlValues, _
                      LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlNext, _
                      MatchCase:=False, _
                      SearchFormat:=True)
                      
                      
  If Not r Is Nothing Then
  
    'Save the found address as the 'First Address'
    'Save the row number in the array to be returned
    iCount = iCount + 1
    sFirstAddress = r.Address(False, False)
    'MsgBox "First occurrence of RED FORMAT is in cell '" & sFirstAddress & "'."
   
    'Search for additional occurences of the 'Format'
    'If found add them to the array to be returned
    bNeedMore = True
    While bNeedMore
      Set r = ws.Cells.Find(What:=sFindString, _
                 After:=r, _
                 LookIn:=xlValues, _
                 LookAt:=xlWhole, _
                 SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, _
                 MatchCase:=False, _
                 SearchFormat:=True)
                 
      'Keep on searching until the first 'Address' is found again
      sAddress = r.Address(False, False)
      If sAddress = sFirstAddress Then
        bNeedMore = False
      Else
        iCount = iCount + 1
        'MsgBox "Next occurrence of RED FORMAT is in cell '" & sAddress & "'."
      End If
    Wend
    
  End If
  
  'Set the return value
  LjmFindRedCells = iCount
  
  'Clear the object pointer
  Set r = Nothing
 

End Function

Similar code for your previous thread:

Function LjmFindNext(ws As Worksheet, sFindString As String) As Long
  'This iterates through a worksheet finding all the occurences of a 'find string'

  Dim r As Range
  Dim iCount As Long
  Dim bNeedMore As Boolean
  Dim sAddress As String
  Dim sFirstAddress As String
  
  'Find the first occurence of the string
  Set r = Nothing
  Set r = ws.Columns("C").Find(What:=sFindString, _
                      After:=ws.Range("C1"), _
                      LookIn:=xlValues, _
                      LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlNext, _
                      MatchCase:=False, _
                      SearchFormat:=False)
                      
                      
  If Not r Is Nothing Then
  
    'Save the found address as the 'First Address'
    'Save the value to be returned
    iCount = iCount + 1
    sFirstAddress = r.Address(False, False)
    MsgBox "First occurrence of '" & sFindString & "' is in cell '" & sFirstAddress & "'."
   
    'Search for additional values
    'If found add them to the array to be returned
    bNeedMore = True
    While bNeedMore
      Set r = ws.Columns("C").FindNext(After:=r)
      sAddress = r.Address(False, False)
      If sAddress = sFirstAddress Then
        bNeedMore = False
      Else
        iCount = iCount + 1
        MsgBox "Next occurrence of '" & sFindString & "' is in cell '" & sAddress & "'."
      End If
    Wend
 
  Else
    'MsgBox "Could not find '" & sFindString & "'"
  End If
 
  LjmFindNext = iCount
 
  'Clear the object pointer
  Set r = Nothing
 
End Function

Lewis

[cwhite86]

Thanks for that, Haven't responded due to security issues on site.

Thanks again.