Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Deleting row unless certain values in certain columns
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 34
Default 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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Deleting row unless certain values in certain columns
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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 34
Default Deleting row unless certain values in certain columns
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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 34
Default Deleting row unless certain values in certain columns
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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 644
Default Deleting row unless certain values in certain columns
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

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Deleting row unless certain values in certain columns
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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Deleting columns Heather Setting up and Configuration of Excel 4 August 28th 09 01:44 PM
Deleting columns Barry Lennox[_2_] Excel Discussion (Misc queries) 3 January 8th 09 10:00 PM
Adding Columns, Then deleting old columns May Excel Discussion (Misc queries) 4 October 30th 08 04:44 PM
Combining Text from 2 Columns into 1 then Deleting the 2 Columns sleepindogg Excel Worksheet Functions 5 September 19th 08 12:36 AM
deleting values in a worksheet without deleting the formulas patti Excel Worksheet Functions 1 October 28th 05 09:49 PM


All times are GMT +1. The time now is 09:04 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement