Macro to delete rows

[qaz]

I would like to have a macro search for the words "activity" and then "date"
then delete the row. They always appear in column A.

Thanks

 

[Chip Pearson]

Try something like the following. It will delete rows in which
either 'activity' or 'date' appears in column A.

Dim RowNdx As Long
Dim LastRow As Long

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If StrComp(Cells(RowNdx, "A"), "activity", vbBinaryCompare) =
0 _
Or StrComp(Cells(RowNdx, "A"), "date", vbBinaryCompare) =
0 Then
Cells(RowNdx, "A").EntireRow.Delete
End If
Next RowNdx



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com (e-mail address removed)

 

[igor]

or try this

Sub delrow()
Dim row1 As Integer
row1 = 2

For row1 = 1 To 10000
If Cells(row1, 1) = "activity" Or Cells(row1, 1) = "date"
Then
Cells(row1, 1).EntireRow.Delete
If Cells(row1, 1).Value = "" Then Exit Sub

End If

Next row1

 

[Ken Wright]

Sub DeleteRowsContaining()
Dim r As Long
Dim ans As String
Dim c As Range
Dim lrow As Long

ans = InputBox("What string do you want rows to be deleted if they contain it?")
Application.ScreenUpdating = False

lrow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
For r = lrow To 1 Step -1
With Cells(r, 1)
Set c = .Find(ans, LookIn:=xlValues)
If Not c Is Nothing Then
.EntireRow.Delete
End If
End With
Next r
Application.ScreenUpdating = True

End Sub

 

[Ken Wright]

Do you mean you want an inputbox to appear that allows you to enter the string that it will search
for, and then delete those rows. If so then try the following tweak of Chip's code:-

Sub DelRowsIf()

Dim RowNdx As Long
Dim LastRow As Long
Dim ans As String

ans = InputBox("What string do you want rows to be deleted if it contains it?")

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If StrComp(Cells(RowNdx, "A"), ans, vbBinaryCompare) = 0 Then
Cells(RowNdx, "A").EntireRow.Delete
End If
Next RowNdx

End Sub