Question

I have a spot of code that throws error 91 when I add an item under Do/With function. (Thanks to chris neilsen for the code)

Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)

Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
            End With
            Set cl = SrchRng.FindNext(cl)
        Loop While cl.Address <> addr
    End If
Next

throws an error when it becomes:

Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)


Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .ClearContents
            End With
            Set cl = SrchRng.FindNext(cl)
        Loop While cl.Address <> addr
    End If
Next

The only addition is the .ClearContents under the Do/With Statement, that doesn't appear to have added a variable to my knowledge unless I am missing something. anyone have any thoughts?

**Note: it does what it's supposed to do, it just throws an error.

Était-ce utile?

La solution

As you are clearing cells, cl may be Nothing so you need to either delete the range outside the loop, or add a testing for Nothing

Method 1 will be quicker

Method 1 - delete range in single shot

Sub A()
Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long
Dim rng2 As Range    

SearchValues = Array(217, 317, 298)

Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With    

For i = LBound(SearchValues) To UBound(SearchValues)
Set rng2 = Nothing
    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
        If Not rng2 Is Nothing Then
            Set rng2 = cl.EntireRow
        Else
            Set rng2 = Union(rng2, cl.EntireRow)
        End If
        Set cl = SrchRng.FindNext(cl)
        Loop While Not cl Is Nothing
    End If
    If Not rng2 Is Nothing Then
        With rng2
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
            .ClearContents
        End With
    End If
Next

End Sub

Method 2

With cl.EntireRow
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
            .ClearContents
End With
    Set cl = SrchRng.FindNext(cl)
Loop While Not cl is Nothing  

Autres conseils

Try this code. I have changed "Loop While cl.Address <> addr" to "Loop Until cl Is Nothing"

Sub main()
Dim ws As Worksheet
Dim SrchRng As Range
Dim SearchValues() As Variant
Dim cl As Range, addr As String
Dim i As Long

SearchValues = Array(217, 317, 298)


Set ws = ActiveSheet
With ws
    Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With

For i = LBound(SearchValues) To UBound(SearchValues)

    Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
    If Not cl Is Nothing Then
        addr = cl.Address
        Do
            With cl.EntireRow
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .ClearContents

            End With
            Set cl = SrchRng.FindNext(cl)
            Loop Until cl Is Nothing
             'Loop While cl.Address <> addr

    End If
Next
End Sub
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top