Reputation: 3
I have written a code, which includes the FindNext method. All the code works so far, only when it gets to the FindNext method it shows an error saying the FindNext Object cannot be assigned. However, I don't see where the Range Object (in this case "cell") is changed in any way for the FindNext method to not be able to assign it. Has anybody got an idea?
Please ignore any chunky written code, I'm very new with VBA ;)
Sub Search()
Dim wks As Worksheet
Set wks = ActiveSheet
Dim cell As Range, sngCell As Range
Dim Count As Long
Dim firstCell As String
Dim rg As Range, lastColumn As Long
Set cell = wks.Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
firstCell = cell.Address
Do
With wks
lastColumn = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column
Set rg = Range(cell, .Cells(cell.Row, lastColumn))
End With
For Each sngCell In rg
If IsNumeric(sngCell.Value) = True Then
If sngCell.Value > 0 Then
If sngCell.Offset(-2, 0).Value > sngCell.Value Then
Count = Count + 1
End If
If Count = 0 Then
Rows(sngCell.Row - 2).Delete
Rows(sngCell.Row - 1).Delete
Rows(sngCell.Row).Delete
End If
End If
End If
Next
Set cell = wks.Cells.FindNext(cell)
Loop While cell.Address <> firstCell
End Sub
Upvotes: 0
Views: 45
Reputation: 166256
Find()
in a loop is complex enough that it's worth splitting it out into a separate function. Here's a slightly different approach which reduces the complexity in your main Sub and allows you to focus on the business rules instead of the nuances of using Find()
Sub Search()
Dim wks As Worksheet
Dim cell As Range, sngCell As Range
Dim firstCell As String
Dim rg As Range, lastColumn As Long, matches As Collection
Set wks = ActiveSheet
Set matches = FindAll(wks.Cells, "Planned Supply at BP|SL (EA)")
For Each cell In matches
Debug.Print "Found:", cell.Address
Set rg = wks.Range(cell, wks.Cells(cell.Row, Columns.Count).End(xlToLeft))
For Each sngCell In rg.Cells
If IsNumeric(sngCell.Value) Then 'no need for `= True`
If sngCell.Value > 0 Then
If sngCell.Offset(-2, 0).Value <= sngCell.Value Then
sngCell.Offset(-2, 0).Resize(3).EntireRow.Delete
Exit For 'stop checking...
End If
End If
End If
Next
Next cell
End Sub
'Find all matches for `val` in `rng` and return as a collection
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range, addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.CountLarge), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function
Upvotes: 1