loop question

D

dabith

hey all

I want to find a value in a worksheet and then delete 5 lines unde
every occurance of the value.

I have been toying with:

For Count = 1 To *x*

Range("A1").Select
Cells.Find(What:="Report", After:=ActiveCell, LookIn:=xlFormulas
_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext
_
MatchCase:=False).Activate
ActiveCell.Rows("1:5").EntireRow.Select
Selection.Delete Shift:=xlUp

Next Count
End Sub

How do i find for *x*

Can someone please tell me how this can be achieved.
thank
 
B

Bob Phillips

Try something like

Dim oCell As Range

Do
Set oCell = Nothing
Set oCell = Cells.Find(What:="Report", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SarchOrder:=xlByRows, _
SarchDirection:=xlNext, _
MatchCase:=False)
If Not oCell Is Nothing Then
oCell.Offset(1,0).Resiez(5,1).EntireRow.Delete Shift:=xlUp
End If
Loop Until oCell Is Nothing


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
D

dabith

Hey Bob

I tried your code but it goes into a continous loop.

I played around with it to output a msg box to no avail. Any ideas???


Dim oCell As Range

Do
Set oCell = Nothing
Set oCell = Cells.Find(What:="1", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not oCell Is Nothing Then
'oCell.Offset(1, 0).Resize(5, 1).EntireRow.Delete Shift:=xlUp
freq = 1
freq = freq + 1
MsgBox "No. of freq: " & freq
End If
Loop Until oCell Is Nothing


Thank
 
R

RB Smissaert

Something like this will do it.
Note that did Lookin:=xlValues

Sub test()

Dim lFindCount As Long
Dim rFindRange As Range
Dim rFirstFound As Range
Dim bFirstFind As Boolean
Dim lFindRow As Long
Dim lFindColumn As Long
Dim lLastRow As Long

lFindRow = ActiveCell.Row
lFindColumn = ActiveCell.Column
lLastRow = 0

'count the cells with the text
'-----------------------------
Do
Set rFindRange = Cells.Find(What:="Report", _
After:=Cells(lFindRow, lFindColumn), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

'to avoid counting twice
'-----------------------
If bFirstFind = True Then
If rFindRange.Address = rFirstFound.Address Then
Exit Do
End If
End If

'set the first found range
'-------------------------
If bFirstFind = False Then
Set rFirstFound = rFindRange
bFirstFind = True
End If

If rFindRange Is Nothing Then
Exit Do
End If

lFindRow = rFindRange.Row
lFindColumn = rFindRange.Column

lFindCount = lFindCount + 1
Loop

lFindRow = ActiveCell.Row
lFindColumn = ActiveCell.Column

'delete the rows
'---------------
Do While i < lFindCount

Set rFindRange = Cells.Find(What:="Report", _
After:=Cells(lFindRow, lFindColumn), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If rFindRange Is Nothing Then
Exit Sub
End If

lFindRow = rFindRange.Row
lFindColumn = rFindRange.Column

'avoid deleting more than once after the same row
'------------------------------------------------
If rFindRange.Row > lLastRow Then
Range(Cells(lFindRow + 1, 1), Cells(lFindRow + 6,
1)).EntireRow.Delete
lLastRow = lFindRow
End If

i = i + 1

Loop

End Sub

I would think that somebody can come up with a simpler solution, but I think
it has to avoid
doing 2 deletes if there are 2 cells in the same row with Report.
The other question is if it should do a delete on rows with a cell that has
the text Report.


RBS
 
R

RB Smissaert

This is a nicer one:

Sub test2()

Dim C As Range
Dim lTopRow As Long
Dim lOldRow As Long

lTopRow = ActiveCell.Row
lOldRow = 0

For Each C In Range(Cells(lTopRow, 1), Cells(lTopRow,
1).SpecialCells(xlLastCell))
If C.Text = "report" Then
lTopRow = C.Row
If lTopRow > lOldRow Then
Range(Cells(lTopRow + 1, 1), Cells(lTopRow + 6,
1)).EntireRow.Delete
lOldRow = lTopRow
End If
End If
Next

End Sub


RBS
 
T

Tom Ogilvy

Bob's code would work if you deleted the cell with the target - but since
you don't oCell will never be nothing.

Sub AAA()
Dim oCell As Range
Dim sAddr As String
Set oCell = Range("IV65536")
Do
Set oCell = Cells.Find(What:="Report", _
After:=oCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Debug.Print oCell.Address
If Not oCell Is Nothing Then
If oCell.Address = sAddr Then Exit Do
If sAddr = "" Then sAddr = oCell.Address
oCell.Offset(1, 0).Resize(5, 1).EntireRow.Delete Shift:=xlUp
End If
Loop While Not oCell Is Nothing
End Sub


--
Regards,
Tom Ogilvy


Bob Phillips said:
Try something like

Dim oCell As Range

Do
Set oCell = Nothing
Set oCell = Cells.Find(What:="Report", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SarchOrder:=xlByRows, _
SarchDirection:=xlNext, _
MatchCase:=False)
If Not oCell Is Nothing Then
oCell.Offset(1,0).Resiez(5,1).EntireRow.Delete Shift:=xlUp
End If
Loop Until oCell Is Nothing


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 
B

Bob Phillips

Needs a FindNext as well

Dim oCell As Range
Dim sAddress As String

With Cells
Set oCell = Nothing
Set oCell = .Find(What:="Report", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not oCell Is Nothing Then
sAddress = oCell.Address
Do
oCell.Offset(1, 0).Resize(5, 1).EntireRow.Delete Shift:=xlUp
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And oCell.Address <> sAddress
End If
End With

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Top