Deleting row unless certain values in certain columns

I need to delete rows unless they have " Return To Tsr " (A space
before and after the phrase) in column O OR " Sales " (A space before
and after the word) in column Q.

I have had trouble getting this done right. What I am working with
currently is below.

I appreciate any help you can provide.

Thanks
Kris

Sub Day1TSR()
Dim row As Long
row = FindLastRow
Sheets("Day 1").Select
Selection.AutoFilter Field:=15, Criteria1:=" Return To Tsr "
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Working").Select
Worksheets("Working").Cells(row, 1).Select
ActiveSheet.Paste
Sheets("Day 1").Select
Range("A1").Activate
Selection.AutoFilter
Application.Run ("QueryUpdate")
End Sub
Sub Day1Sales()
Dim row As Long
row = FindLastRow
Sheets("Day 1").Select
Selection.AutoFilter Field:=17, Criteria1:=" Sales "
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Working").Select
Worksheets("Working").Cells(row, 1).Select
ActiveSheet.Paste
Sheets("Day 1").Select
Range("A1").Activate
Selection.AutoFilter
Application.Run ("Day1TSR")
End Sub

I could not get your code to work either. If you are not tied to your code
maybe you can incorporate this.

If not at least your question is at the top again.

First copy all the data to your "Working" sheet. Make a selection that spans
all the applicable rows.

Sub DelRow_Criteria_Not_In_OandQ()
Dim rng As Integer
Dim i As Integer

rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False

For i = 1 To rng

If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
Cells(ActiveCell.row, 17) = " Sales " Then
ActiveCell.Offset(1, 0).Select

Else
Selection.EntireRow.Delete

End If

Next i
Application.ScreenUpdating = True
End Sub


Kris wrote:
>I need to delete rows unless they have " Return To Tsr " (A space
>before and after the phrase) in column O OR " Sales " (A space before
>and after the word) in column Q.
>
>I have had trouble getting this done right. What I am working with
>currently is below.
>
>I appreciate any help you can provide.
>
>Thanks
>Kris
>
> Sub Day1TSR()
> Dim row As Long
> row = FindLastRow
> Sheets("Day 1").Select
> Selection.AutoFilter Field:=15, Criteria1:=" Return To Tsr "
> ActiveWindow.ScrollColumn = 1
> Range("A1").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Application.CutCopyMode = False
> Selection.Copy
> Sheets("Working").Select
> Worksheets("Working").Cells(row, 1).Select
> ActiveSheet.Paste
> Sheets("Day 1").Select
> Range("A1").Activate
> Selection.AutoFilter
> Application.Run ("QueryUpdate")
> End Sub
> Sub Day1Sales()
> Dim row As Long
> row = FindLastRow
> Sheets("Day 1").Select
> Selection.AutoFilter Field:=17, Criteria1:=" Sales "
> ActiveWindow.ScrollColumn = 1
> Range("A1").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Application.CutCopyMode = False
> Selection.Copy
> Sheets("Working").Select
> Worksheets("Working").Cells(row, 1).Select
> ActiveSheet.Paste
> Sheets("Day 1").Select
> Range("A1").Activate
> Selection.AutoFilter
> Application.Run ("Day1TSR")
> End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200607/1

Yes I can incorporate this it basically gives me what I need. Thanks so
much for the help.

I might have some troubles changing every just right so that my pivot
tables will work correctly. If I do have more trouble I will be back.


Thank you again.


skatonni via OfficeKB.com wrote:
> I could not get your code to work either. If you are not tied to your code
> maybe you can incorporate this.
>
> If not at least your question is at the top again.
>
> First copy all the data to your "Working" sheet. Make a selection that spans
> all the applicable rows.
>
> Sub DelRow_Criteria_Not_In_OandQ()
> Dim rng As Integer
> Dim i As Integer
>
> rng = Selection.Rows.Count
> ActiveCell.Offset(0, 0).Select
> Application.ScreenUpdating = False
>
> For i = 1 To rng
>
> If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
> Cells(ActiveCell.row, 17) = " Sales " Then
> ActiveCell.Offset(1, 0).Select
>
> Else
> Selection.EntireRow.Delete
>
> End If
>
> Next i
> Application.ScreenUpdating = True
> End Sub
>
>
> Kris wrote:
> >I need to delete rows unless they have " Return To Tsr " (A space
> >before and after the phrase) in column O OR " Sales " (A space before
> >and after the word) in column Q.
> >
> >I have had trouble getting this done right. What I am working with
> >currently is below.
> >
> >I appreciate any help you can provide.
> >
> >Thanks
> >Kris
> >
> > Sub Day1TSR()
> > Dim row As Long
> > row = FindLastRow
> > Sheets("Day 1").Select
> > Selection.AutoFilter Field:=15, Criteria1:=" Return To Tsr "
> > ActiveWindow.ScrollColumn = 1
> > Range("A1").Select
> > Range(Selection, Selection.End(xlToRight)).Select
> > Range(Selection, Selection.End(xlDown)).Select
> > Application.CutCopyMode = False
> > Selection.Copy
> > Sheets("Working").Select
> > Worksheets("Working").Cells(row, 1).Select
> > ActiveSheet.Paste
> > Sheets("Day 1").Select
> > Range("A1").Activate
> > Selection.AutoFilter
> > Application.Run ("QueryUpdate")
> > End Sub
> > Sub Day1Sales()
> > Dim row As Long
> > row = FindLastRow
> > Sheets("Day 1").Select
> > Selection.AutoFilter Field:=17, Criteria1:=" Sales "
> > ActiveWindow.ScrollColumn = 1
> > Range("A1").Select
> > Range(Selection, Selection.End(xlToRight)).Select
> > Range(Selection, Selection.End(xlDown)).Select
> > Application.CutCopyMode = False
> > Selection.Copy
> > Sheets("Working").Select
> > Worksheets("Working").Cells(row, 1).Select
> > ActiveSheet.Paste
> > Sheets("Day 1").Select
> > Range("A1").Activate
> > Selection.AutoFilter
> > Application.Run ("Day1TSR")
> > End Sub
>
> --
> Message posted via OfficeKB.com
> http://www.officekb.com/Uwe/Forums.a...mming/200607/1

This is acting slow for me. I know it is alot of data to be processing
but if any one could help me streamline this it would be appreciated.
This is what I am using so far.

Sheets("Working").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.Run ("DelRow_Criteria_Not_In_OandQ")

End Sub


Sub DelRow_Criteria_Not_In_OandQ()
Dim rng As Integer
Dim i As Integer


rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False


For i = 1 To rng


If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
Cells(ActiveCell.row, 17) = " Sales " Then
ActiveCell.Offset(1, 0).Select


Else
Selection.EntireRow.Delete


End If


Next i
Application.ScreenUpdating = True
Application.Run ("QueryUpdate")
End Sub



Kris wrote:
> Yes I can incorporate this it basically gives me what I need. Thanks so
> much for the help.
>
> I might have some troubles changing every just right so that my pivot
> tables will work correctly. If I do have more trouble I will be back.
>
>
> Thank you again.
>
>
> skatonni via OfficeKB.com wrote:
> > I could not get your code to work either. If you are not tied to your code
> > maybe you can incorporate this.
> >
> > If not at least your question is at the top again.
> >
> > First copy all the data to your "Working" sheet. Make a selection that spans
> > all the applicable rows.
> >
> > Sub DelRow_Criteria_Not_In_OandQ()
> > Dim rng As Integer
> > Dim i As Integer
> >
> > rng = Selection.Rows.Count
> > ActiveCell.Offset(0, 0).Select
> > Application.ScreenUpdating = False
> >
> > For i = 1 To rng
> >
> > If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
> > Cells(ActiveCell.row, 17) = " Sales " Then
> > ActiveCell.Offset(1, 0).Select
> >
> > Else
> > Selection.EntireRow.Delete
> >
> > End If
> >
> > Next i
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> > Kris wrote:
> > >I need to delete rows unless they have " Return To Tsr " (A space
> > >before and after the phrase) in column O OR " Sales " (A space before
> > >and after the word) in column Q.
> > >
> > >I have had trouble getting this done right. What I am working with
> > >currently is below.
> > >
> > >I appreciate any help you can provide.
> > >
> > >Thanks
> > >Kris
> > >
> > > Sub Day1TSR()
> > > Dim row As Long
> > > row = FindLastRow
> > > Sheets("Day 1").Select
> > > Selection.AutoFilter Field:=15, Criteria1:=" Return To Tsr "
> > > ActiveWindow.ScrollColumn = 1
> > > Range("A1").Select
> > > Range(Selection, Selection.End(xlToRight)).Select
> > > Range(Selection, Selection.End(xlDown)).Select
> > > Application.CutCopyMode = False
> > > Selection.Copy
> > > Sheets("Working").Select
> > > Worksheets("Working").Cells(row, 1).Select
> > > ActiveSheet.Paste
> > > Sheets("Day 1").Select
> > > Range("A1").Activate
> > > Selection.AutoFilter
> > > Application.Run ("QueryUpdate")
> > > End Sub
> > > Sub Day1Sales()
> > > Dim row As Long
> > > row = FindLastRow
> > > Sheets("Day 1").Select
> > > Selection.AutoFilter Field:=17, Criteria1:=" Sales "
> > > ActiveWindow.ScrollColumn = 1
> > > Range("A1").Select
> > > Range(Selection, Selection.End(xlToRight)).Select
> > > Range(Selection, Selection.End(xlDown)).Select
> > > Application.CutCopyMode = False
> > > Selection.Copy
> > > Sheets("Working").Select
> > > Worksheets("Working").Cells(row, 1).Select
> > > ActiveSheet.Paste
> > > Sheets("Day 1").Select
> > > Range("A1").Activate
> > > Selection.AutoFilter
> > > Application.Run ("Day1TSR")
> > > End Sub
> >
> > --
> > Message posted via OfficeKB.com
> > http://www.officekb.com/Uwe/Forums.a...mming/200607/1

How about using autofilter to speed this up?
Sub DelRow_Criteria_Not_In_OandQ()
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="<>* Return To Tsr *",
Operator:=xlAnd
Selection.AutoFilter Field:=17, Criteria1:="<>* Sales *",
Operator:=xlAnd
Range("A2", Cells(Range("A2").End(xlDown).Row, _
Range("A2").End(xlToRight).Column)). _
SpecialCells(xlCellTypeVisible).EntireRow.Delete
Selection.AutoFilter
Application.ScreenUpdating = True
Application.Run ("QueryUpdate")
End Sub

This prevents you from evaluating potentially 1000s of line with VB.
The AutoFilter code is much more efficient

HTH

Die_Another_Day

Kris wrote:
> This is acting slow for me. I know it is alot of data to be processing
> but if any one could help me streamline this it would be appreciated.
> This is what I am using so far.
>
> Sheets("Working").Select
> Range("A2").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
> Application.Run ("DelRow_Criteria_Not_In_OandQ")
>
> End Sub
>
>
> Sub DelRow_Criteria_Not_In_OandQ()
> Dim rng As Integer
> Dim i As Integer
>
>
> rng = Selection.Rows.Count
> ActiveCell.Offset(0, 0).Select
> Application.ScreenUpdating = False
>
>
> For i = 1 To rng
>
>
> If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
> Cells(ActiveCell.row, 17) = " Sales " Then
> ActiveCell.Offset(1, 0).Select
>
>
> Else
> Selection.EntireRow.Delete
>
>
> End If
>
>
> Next i
> Application.ScreenUpdating = True
> Application.Run ("QueryUpdate")
> End Sub
>
>
>
> Kris wrote:
> > Yes I can incorporate this it basically gives me what I need. Thanks so
> > much for the help.
> >
> > I might have some troubles changing every just right so that my pivot
> > tables will work correctly. If I do have more trouble I will be back.
> >
> >
> > Thank you again.
> >
> >
> > skatonni via OfficeKB.com wrote:
> > > I could not get your code to work either. If you are not tied to your code
> > > maybe you can incorporate this.
> > >
> > > If not at least your question is at the top again.
> > >
> > > First copy all the data to your "Working" sheet. Make a selection that spans
> > > all the applicable rows.
> > >
> > > Sub DelRow_Criteria_Not_In_OandQ()
> > > Dim rng As Integer
> > > Dim i As Integer
> > >
> > > rng = Selection.Rows.Count
> > > ActiveCell.Offset(0, 0).Select
> > > Application.ScreenUpdating = False
> > >
> > > For i = 1 To rng
> > >
> > > If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
> > > Cells(ActiveCell.row, 17) = " Sales " Then
> > > ActiveCell.Offset(1, 0).Select
> > >
> > > Else
> > > Selection.EntireRow.Delete
> > >
> > > End If
> > >
> > > Next i
> > > Application.ScreenUpdating = True
> > > End Sub
> > >
> > >
> > > Kris wrote:
> > > >I need to delete rows unless they have " Return To Tsr " (A space
> > > >before and after the phrase) in column O OR " Sales " (A space before
> > > >and after the word) in column Q.
> > > >
> > > >I have had trouble getting this done right. What I am working with
> > > >currently is below.
> > > >
> > > >I appreciate any help you can provide.
> > > >
> > > >Thanks
> > > >Kris
> > > >
> > > > Sub Day1TSR()
> > > > Dim row As Long
> > > > row = FindLastRow
> > > > Sheets("Day 1").Select
> > > > Selection.AutoFilter Field:=15, Criteria1:=" Return To Tsr "
> > > > ActiveWindow.ScrollColumn = 1
> > > > Range("A1").Select
> > > > Range(Selection, Selection.End(xlToRight)).Select
> > > > Range(Selection, Selection.End(xlDown)).Select
> > > > Application.CutCopyMode = False
> > > > Selection.Copy
> > > > Sheets("Working").Select
> > > > Worksheets("Working").Cells(row, 1).Select
> > > > ActiveSheet.Paste
> > > > Sheets("Day 1").Select
> > > > Range("A1").Activate
> > > > Selection.AutoFilter
> > > > Application.Run ("QueryUpdate")
> > > > End Sub
> > > > Sub Day1Sales()
> > > > Dim row As Long
> > > > row = FindLastRow
> > > > Sheets("Day 1").Select
> > > > Selection.AutoFilter Field:=17, Criteria1:=" Sales "
> > > > ActiveWindow.ScrollColumn = 1
> > > > Range("A1").Select
> > > > Range(Selection, Selection.End(xlToRight)).Select
> > > > Range(Selection, Selection.End(xlDown)).Select
> > > > Application.CutCopyMode = False
> > > > Selection.Copy
> > > > Sheets("Working").Select
> > > > Worksheets("Working").Cells(row, 1).Select
> > > > ActiveSheet.Paste
> > > > Sheets("Day 1").Select
> > > > Range("A1").Activate
> > > > Selection.AutoFilter
> > > > Application.Run ("Day1TSR")
> > > > End Sub
> > >
> > > --
> > > Message posted via OfficeKB.com
> > > http://www.officekb.com/Uwe/Forums.a...mming/200607/1

I think the problem is all the selecting.

Try this, apparently well know technique, where you work backwards without
selecting.

With the header row included in the selection.

Sub DelRow_Criteria_Not_In_OandQ_Backwards()
Dim rng As Integer
Dim i As Integer

rng = Selection.Rows.Count

Application.ScreenUpdating = False

For i = rng To 2 Step -1

If Cells(i, 15) = " Return To Tsr " Or _
Cells(i, 17) = " Sales " Then
'keep
Else
Cells(i, 1).EntireRow.Delete
End If

Next i
Application.ScreenUpdating = True
End Sub

You could see if a "Not" saves any time:

If Not (Cells(i, 15) = " Return To Tsr " Or _
Cells(i, 17) = " Sales ") Then

Cells(i, 1).EntireRow.Delete
End If

Kris wrote:
>This is acting slow for me. I know it is alot of data to be processing
>but if any one could help me streamline this it would be appreciated.
>This is what I am using so far.
>
> Sheets("Working").Select
> Range("A2").Select
> Range(Selection, Selection.End(xlToRight)).Select
> Range(Selection, Selection.End(xlDown)).Select
>Application.Run ("DelRow_Criteria_Not_In_OandQ")
>
>End Sub
>
>Sub DelRow_Criteria_Not_In_OandQ()
>Dim rng As Integer
>Dim i As Integer
>
>rng = Selection.Rows.Count
>ActiveCell.Offset(0, 0).Select
>Application.ScreenUpdating = False
>
>For i = 1 To rng
>
>If Cells(ActiveCell.row, 15) = " Return To Tsr " Or _
> Cells(ActiveCell.row, 17) = " Sales " Then
> ActiveCell.Offset(1, 0).Select
>
>Else
> Selection.EntireRow.Delete
>
>End If
>
>Next i
>Application.ScreenUpdating = True
>Application.Run ("QueryUpdate")
>End Sub
>
>> Yes I can incorporate this it basically gives me what I need. Thanks so
>> much for the help.
>[quoted text clipped - 89 lines]
>> > Message posted via OfficeKB.com
>> > http://www.officekb.com/Uwe/Forums.a...mming/200607/1

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200607/1