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

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

SteveC - 25 Jan 2006 16:03 GMT

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.

Reply to this Message

Ron de Bruin - 25 Jan 2006 16:11 GMT

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

Signature

Regards Ron de Bruin
http://www.rondebruin.nl

> 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.
[quoted text clipped - 9 lines]
>
> Thanks so much for your help.

Reply to this Message

SteveC - 25 Jan 2006 18:10 GMT

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

Reply to this Message

Ron de Bruin - 25 Jan 2006 18:21 GMT

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

Signature

Regards Ron de Bruin
http://www.rondebruin.nl

> Ron and all, thanks very much. I implemented Ron's solution because it was
> the first response and it works great.
[quoted text clipped - 15 lines]
> Sincerely,
> SteveC

Reply to this Message

SteveC - 25 Jan 2006 19:11 GMT

Thanks very much.

Reply to this Message

Gary''s Student - 25 Jan 2006 16:30 GMT

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.

Signature

Gary's Student

Reply to this Message

Tom Ogilvy - 25 Jan 2006 16:34 GMT

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

Signature

Regards,
Tom Ogilvy

Reply to this Message

Crowbar - 25 Jan 2006 16:44 GMT

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

Reply to this Message