Delete Rows that Contain the Text "Total" and vice versa

[Guest]

Hi, I'm rusty on VBA and I tried mimicking a few solutions already posted but
I couldn't get them to work. I am trying to create two separate macros.

Macro 1:
I would like to delete rows that contain the text "Total" in Column A (e.g.,
Total Apples, Total Oranges, Total Bannanas and Grapes -- delete all those
rows).

Macro 2:
I would like to delete rows that do NOT contain the text "Total" in Column
A.

Thanks so much for your help.

 

[Ron de Bruin]

Hi Steve

You can use AutoFilter

For part 2 use
DeleteValue = "<>*Total*"


Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range

DeleteValue = "*Total*"
With ActiveSheet
.Range("A1:A100").AutoFilter Field:=1, Criteria1:=DeleteValue
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete

End With
.AutoFilterMode = False
End With
End Sub



More tips you can find here
http://www.rondebruin.nl/delete.htm

 

[Guest]

For part 1:


Sub Total_killer()
Dim j As Long
Dim i As Long
Dim r As Range
Dim s As String

s = "Total"
j = 65536
For i = 1 To j
If InStr(1, Cells(i, 1).Value, s) > 0 Then
If r Is Nothing Then
Set r = Rows(i)
Else
Set r = Union(r, Rows(i))
End If
End If
Next i

If Not r Is Nothing Then
r.Delete
End If
End Sub

For the second part, try testing for InStr()=0 instead.


B.T.W. - If you have absolute faith in any of the forms of LastRow, then you
can trim-down the 65536.

 

[Tom Ogilvy]

Sub DeleteTotalRows()
Dim rng as Range, sAddr as String
set rng = columns(1).Find("Total",Lookat:=xlPart)
if not rng is nothing then
sAddr = rng.Address
rng.EntireRow.Delete
set rng = range(sAddr)
set rng = columns(1).FindNext(rng)
Loop while not rng is nothing
End Sub

Sub DeleteNonTotalRows()
Dim rng as Range
Dim lastrow as Long, i as Long
lastrow = cells(rows.count,1).end(xlup)
for i = lastrow to 1 step -1
if instr(1,cells(i,1),"total",vbTextCompare) = 0 then
if rng is nothing then
set rng = Cells(i,1)
else
set rng = Union(cells(i,1),rng)
end if
end if
Next
if not rng is nothing then
rng.Entirerow.Delete
end if
End sub

 

[Crowbar via OfficeKB.com]

This should keep total, but I do think you should have an auto filter that
can take them out and put them back in!

TDim rngTarget As Range
Dim lRow As Long
Dim lLastRow As Long

With Worksheets("OS")
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lRow = 1 To lLastRow
If Not .Cells(lRow, 1).Value = "Total" Then
If Not rngTarget Is Nothing Then
Set rngTarget = Application.Union(rngTarget, _
.Cells(lRow, 1).EntireRow)
Else
Set rngTarget = .Cells(lRow, 1).EntireRow
End If
End If
Next lRow
End With

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

 

[Guest]

Ron and all, thanks very much. I implemented Ron's solution because it was
the first response and it works great.

A follow up question for you, if I may:

I'd like to try using the macro provided in a larger macro. To start out,
I'd like to duplicate the Active Worksheet twice, with the first duplicate
named: "Apples" and the second duplicate named "Oranges."

Any suggestions?

I tried recording a simpler macro on my own, but it only works if the
original worksheet is named "Sheet1." I can't get it to work just for the
Active Sheet.

Thanks very much for your time Ron and everyone.

Sincerely,
SteveC

 

[Ron de Bruin]

Try this

Sub test()
Dim sh As Worksheet
Set sh = ActiveSheet
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Apples"
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Oranges"
sh.Select
End Sub

 

[Guest]

Thanks very much.