PDA

View Full Version : Solved: Finding a Deleting Multiple Occurences using FindNext



Banixxx
12-11-2007, 05:12 PM
OK so Im trying to search and find all occurences of the word "Center Report" and then when it finds ones i want to delete a range of cells around it and then move to the next finding of "Center Report" but with the below current code i get an erro saying cant do FindNext on a Range any suggestions?

Dim R As Range, FindAddress As String

'Set the range in which we want to search in
With Range("A1:AZ2000")
'Search for the first occurrence of the item
Set R = .Find("Center Report")
'If a match is found then
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in a variable
FindAddress = R.Address
Do
'Color the cell where a match is found yellow
tempRow = R.Row
tempCol = R.Column
Cells(tempRow, tempCol).Select
Range(Cells(ActiveCell.Row - 3, ActiveCell.Column), Cells(ActiveCell.Row + 8, ActiveCell.Column + 4)).Select
Selection.Delete Shift:=xlUp

'Search for the next cell with a matching value
Set R = .FindNext(R)
'Search for all the other occurrences of the item i.e.
'Loop as long matches are found, and the address of the cell where a match is found,
'is different from the address of the cell where the first match is found (FindAddress)
Loop While Not R Is Nothing And R.Address <> FindAddress
End If
End With

'Clear memory
Set R = Nothing

Jacob Hilderbrand
12-11-2007, 05:24 PM
Try this:


Option Explicit

Sub ReplaceIt()

Dim StartRow As Long
Dim FindAddress As String
Dim R As Range
Dim DelRange As Range

'Set the range in which we want to search in
With Range("A1:AZ2000")
'Search for the first occurrence of the item
Set R = .Find("Center Report")
'If a match is found then
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in a variable
FindAddress = R.Address
Do
StartRow = Application.WorksheetFunction.Max(R.Row - 3, 1)
If DelRange Is Nothing Then
Set DelRange = Range(Cells(StartRow, R.Column), Cells(R.Row + 8, R.Column + 4))
Else
Set DelRange = Union(DelRange, Range(Cells(StartRow, R.Column), Cells(R.Row + 8, R.Column + 4)))
End If
Set R = .FindNext(R)
Loop While Not R Is Nothing And R.Address <> FindAddress
End If
End With

If Not DelRange Is Nothing Then
DelRange.Delete Shift:=xlUp
End If

'Clear memory
Set R = Nothing
Set DelRange = Nothing

End Sub

Banixxx
12-12-2007, 01:08 PM
Awesome that worked. OK so to make sure i understand what happened we essentially added the selections to a variable and did the deleting out side of the FINDNEXT execution to avoid the whole error correct?

Jacob Hilderbrand
12-13-2007, 02:06 PM
You should try to delete everything at once, it is faster and also stop problems if you delete something and then later refer to it in a loop or such.