Pergunta

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.

Foi útil?

Solução

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  

Outras dicas

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
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top