Code continually looping when finding cells with a particular format. 1

[HairyHippy]

I am trying to locate all cells with a particular colour and clear the contents of these cells. The following code just continues to loop, despite that only a small number of cells actually has the colour in question, in a test spreadsheet (spreadsheet I'm trying to apply this to has thousands of these specific cells). Here is the code:

Sub SelectByFormatAndClearContents()
'checks version of Excel to see if it can use FindFormat
If Val(Application.Version) < 10 Then
MsgBox "This requires Excel 2002 or later."
Exit Sub
End If

Dim FirstCell As Range, FoundCell As Range
Dim AllCells As Range

'specifies the format to look for
With Application.FindFormat.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 36 'light yellow
End With

Set FirstCell = Cells.Find(What:="", SearchFormat:=True)

If FirstCell Is Nothing Then
MsgBox "No matching cells were found."
Exit Sub
End If

'initialise AllCells
Set AllCells = FirstCell
Set FoundCell = FirstCell

'loop until FirstCell is found again
Do
Set FoundCell = Cells.FindNext(After:=FoundCell)
Set AllCells = Union(FoundCell, AllCells)
If FoundCell.Address = FirstCell.Address Then Exit Do
Loop

'select cells found and clear the contents
AllCells.Select
Selection.ClearContents

End Sub

 

[Loomah]

Hi
I can't test this as I don't have xlXP so no findformat but I was struggling to find a problem with your code.

I've tried a sligtly different approach that should work. This type of thing works for me using numbers etc so the only bit not tested is the findformat.

Sub mit()
Dim FirstCell As String, c As Range
Dim AllCells As Range, FoundCell As Range
    
    'specifies the format to look for
    With Application.FindFormat.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 36 'light yellow
    End With

With Worksheets(1).Cells
    Set c = .Find("", SearchFormat:=True)
    If Not c Is Nothing Then
        FirstCell = c.Address
        Set AllCells = Range(FirstCell)
        Do
            Set c = .FindNext(c)
            Set AllCells = Union(c, AllCells)
        Loop While Not c Is Nothing And c.Address <> FirstCell
    Else
        MsgBox "No matching cells were found."
    End If
    AllCells.ClearContents
End With

End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[SkipVought]

Hi,

Add FoundCell.Select, STEP thru you loop and OBSERVE the SELECTED CELLS.

Is this what you want to happen?

    Do[b]
        FoundCell.Select[/b]
        Set FoundCell = Cells.FindNext(After:=FoundCell)
        Set AllCells = Union(FoundCell, AllCells)
        If FoundCell.Address = FirstCell.Address Then Exit Do
    Loop

Skip,

[red]Be advised:[/red] Alcohol and Calculus do not mix!
If you drink, don't derive!

Want to get great answers to your Tek-Tips questions? Have a look at FAQ222-2244

 

[HairyHippy]

Loomah - Unfortunately, your method didn't work either, just looped.

SkipVought - Almost there!
It now actually finds the first cell with the correct colour but then when it goes around the loop it selects the cell to the left (doesn't have any colour) and then on next loop selects the cell to the left again (again, doesn't have any colour).

 

[HairyHippy]

In my last post - I meant it it moves to the right.

In fact, let me be a bit more specific. The test spreadsheet only has the colour in cells B3:B8. Starting with A1 selected and then running the code, once it reaches the line Set FoundCell = Cells.FindNext(After:=FoundCell) it selects cell B3, then upon the next loop it selects cell C3, then D3, etc, etc until the end of the row. At the end of the row it selects A4 and continues to the end of the row. this happens up until cell A9 is selected and then upon the next loop it selects cell A1 again, and then goes into constant loop without selecting any other cells (in otherwords satys on cell A1 and just loops).

 

[SkipVought]

substitute

        Set FoundCell = Cells.Find(What:="", After:=FoundCell, SearchFormat:=True)

instead of FindNext.

Skip,

[red]Be advised:[/red] Alcohol and Calculus do not mix!
If you drink, don't derive!

Want to get great answers to your Tek-Tips questions? Have a look at FAQ222-2244

 

[HairyHippy]

Fantastic Skip - Many Thanks!!! Been bugging me for 2 whole days! :-D

 

[Loomah]

AdeyB
Glad you found your solution!

As I said (well, kinda implied!) I was basically guessing as I am on xl2k so there's no find format!!

My code will work with numbers etc. if you need it in the future!!

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[HairyHippy]

Now I've applied this to the spreadsheet I actually want it to work on, I'm getting a Run-Time error'91': Object variable or With block variable not set as the code hits the FoundCell.Select line. Any ideas?

 

[Loomah]

As you step throught the code does FoundCell have a value prior to the problem line?

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[HairyHippy]

This is actually infuriating!
I know that the colour I which to search for is on the spreadsheet in question (proved by using a function called CellColorIndex:

Function CellColorIndex(InRange As Range, Optional _
    OfText As Boolean = False) As Integer
'
' This function returns the ColorIndex value of a the Interior
' (background) of a cell, or, if OfText is true, of the Font in the cell.
'
Application.Volatile True
If OfText = True Then
    CellColorIndex = InRange(1, 1).Font.ColorIndex
Else
    CellColorIndex = InRange(1, 1).Interior.ColorIndex
End If

End Function

so the code I used was as follows:

Sub ClearContentsOfYellowCells()
  
    Dim FirstCell As Range, FoundCell As Range
    Dim AllCells As Range
    
    'specifies the format to look for
    With Application.FindFormat.Interior
        .ColorIndex = 36 'light yellow
    End With
    
    Set FirstCell = Cells.Find("", SearchFormat:=True)

    'initialise AllCells
    Set AllCells = FirstCell
    Set FoundCell = FirstCell
    
    'loop until FirstCell is found again
    Do
        FoundCell.Select
        Set FoundCell = Cells.Find(What:="", After:=FoundCell, SearchFormat:=True)
        Set AllCells = Union(FoundCell, AllCells)
        If FoundCell.Address = FirstCell.Address Then Exit Do
    Loop
    
    'select cells found and clear the contents
    AllCells.Select
    Selection.ClearContents
    
End Sub

It then came up with that error code. If I put the code about if no match back in, it says "No matching cells found" - But I know that they're there - any clues?

 

[Loomah]

Hi
Your code would seem to be missing the cell when performing the find - stating the obvious I know!!

Unfortunately, if that is the cse, I'm not in a position to help due to xl versions and I have a feeling that it's something to do with the searchformat.

Maybe someone else will pick this up again??
;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[PHV]

Have you tried to replace this:
Set FirstCell = Cells.Find("", SearchFormat:=True)
By something like this ?
Set FirstCell = Cells.Find(What:="", SearchFormat:=True)
If FirstCell Is nothing Then Exit Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244