Find and delete offset loop

  • Thread starter Thread starter Karin
  • Start date Start date
K

Karin

Hi,
I want to find "chargeable hours", then go down 1 row and see if there is
any data in column B -- if there IS data, I want to delete the row. I want
to loop through the spreadsheet.
Thank you!
 
I've got this far, but I don't know how to tell it to stop when it can't find
it anymore.

Do
Cells.Find(What:="Chargeable Hours", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(1, 1).Select

If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
End If
 
Give this code a try instead (where I have assumed your "chargeable hours"
text is in Column A)...

Sub RemoveChargeableHours()
Dim X As Long, C As Range, FirstAddress As String
With Worksheets("Sheet1").Columns("A")
Set C = .Find("chargeable hours", LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchDirection:=xlPrevious)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If Len(Cells(C.Row + 1, "B")) > 0 Then Rows(C.Row + 1).Delete
Set C = .FindNext(C)
X = X + 1
Loop While X < Application.CountIf(Columns("A"), "chargeable hours")
End If
End With
End Sub
 
Hi Karin

You have to record the first match found then loop until FirstMatch address
= actual match address:

Sub aaa()
Set f = Cells.Find(What:="Chargeable Hours", _
After:=Range("A1"), LookIn:= xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
Set FirstMatch = f
Do
If Not IsEmpty(f.Offset(1, 1).Value) Then
f.Offset(1, 0).Delete Shift:=xlUp
End If
Set f = Cells.FindNext(After:=f)
Loop Until f.Address = FirstMatch.Address
End If
End Sub

Regards,
Per
 
The most traditional approach to tackle this task is to loop through the
entire column, check to see if each cell contains the value and, if it does,
delete the row. Since Excel shifts rows upwards when they are deleted, it is
best to start at the bottom of the column and work upwards thereby negating
the row shift effect.

I am not sure that I have fully understood your request but have a play with
the following code & see if it gets you started.

Sub DeleteRows()
Dim EndRow As Long
Dim StartRow As Long
Dim Lr As Long

'ignore header
StartRow = 2

With Worksheets("Sheet1")

EndRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For Lr = EndRow To StartRow Step -1

If .Cells(Lr, 1).Value = "Chargeable Hours" Then

If Not IsEmpty(.Cells(Lr, 1).Offset(1, 1).Value) Then

.Rows(Lr).EntireRow.Delete

End If

End If

Next

End With
End Sub
 
Back
Top