Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 39
Default Conditionally retain rows

I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions (delete
rows where the conditons are not met). For example, I want to delete all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops through for
each condition) but it seems the logic deletes the row because it does not
match condition 1, even if it would have matched a later condition. The row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50
  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 39
Default Conditionally retain rows

Thanks for the quick response. As I said, a bit repetitive, but here you go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

"Don Guillett" wrote:

As always, post your code for comments and suggestions.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions
(delete
rows where the conditons are not met). For example, I want to delete all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops through
for
each condition) but it seems the logic deletes the row because it does not
match condition 1, even if it would have matched a later condition. The
row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50




  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 39
Default Conditionally retain rows

Just to restate, I want to retain rows that match a different list.
BL

"wal50" wrote:

Thanks for the quick response. As I said, a bit repetitive, but here you go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

"Don Guillett" wrote:

As always, post your code for comments and suggestions.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions
(delete
rows where the conditons are not met). For example, I want to delete all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops through
for
each condition) but it seems the logic deletes the row because it does not
match condition 1, even if it would have matched a later condition. The
row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50




  #5   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 10,124
Default Conditionally retain rows

Try this simpler idea and post back.

mystr = "59,3100,3101"
x = 3100'your value
If InStr(mystr, x) = 0 Then MsgBox "NO"

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
Thanks for the quick response. As I said, a bit repetitive, but here you
go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

"Don Guillett" wrote:

As always, post your code for comments and suggestions.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions
(delete
rows where the conditons are not met). For example, I want to delete
all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops through
for
each condition) but it seems the logic deletes the row because it does
not
match condition 1, even if it would have matched a later condition.
The
row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50








  #6   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 39
Default Conditionally retain rows

Thanks for the response. But I'm missing something. If I put your code into
a new module, I get a message box (No) when it runs.
FYI: The source info varies daily and may (or may not) have input from
1000+ departments (59, 3100, 31010, etc.), so it would be difficult to define
the total population. My VBA knowledge is limited, but if that the intent
of defining "mystr" it will be quite a list.
Of the 1000+, I want to retain 10-12 depts which will infrequently vary.
When the retain list changes, my plan was to modify the code for the new
numbers.
wal50

"Don Guillett" wrote:

Try this simpler idea and post back.

mystr = "59,3100,3101"
x = 3100'your value
If InStr(mystr, x) = 0 Then MsgBox "NO"

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
Thanks for the quick response. As I said, a bit repetitive, but here you
go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

"Don Guillett" wrote:

As always, post your code for comments and suggestions.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions
(delete
rows where the conditons are not met). For example, I want to delete
all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops through
for
each condition) but it seems the logic deletes the row because it does
not
match condition 1, even if it would have matched a later condition.
The
row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50






  #7   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 10,124
Default Conditionally retain rows

As I understand it ,the idea is to have it do it for all BUT your list. Do
you want to delete the entire row where the value in the cell is NOT one of
the 10-12???

You may sent a workbook to the address below with a copy of this thread and
complete and clear instruction of what you want. I do not want to go back to
this to see what it was about and I do not want to guess what you want.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
Thanks for the response. But I'm missing something. If I put your code
into
a new module, I get a message box (No) when it runs.
FYI: The source info varies daily and may (or may not) have input from
1000+ departments (59, 3100, 31010, etc.), so it would be difficult to
define
the total population. My VBA knowledge is limited, but if that the
intent
of defining "mystr" it will be quite a list.
Of the 1000+, I want to retain 10-12 depts which will infrequently vary.
When the retain list changes, my plan was to modify the code for the new
numbers.
wal50

"Don Guillett" wrote:

Try this simpler idea and post back.

mystr = "59,3100,3101"
x = 3100'your value
If InStr(mystr, x) = 0 Then MsgBox "NO"

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
Thanks for the quick response. As I said, a bit repetitive, but here
you
go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

"Don Guillett" wrote:

As always, post your code for comments and suggestions.

--
Don Guillett
SalesAid Software

"wal50" wrote in message
...
I have a macro (thanks to this site) that deletes rows that do not
meet
conditions. I now have reason retain rows that meet the conditions
(delete
rows where the conditons are not met). For example, I want to
delete
all
rows where col2 < any of up to 12 different branch numbers.
I tried changing the = to < in the existing macro (which loops
through
for
each condition) but it seems the logic deletes the row because it
does
not
match condition 1, even if it would have matched a later condition.
The
row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50








Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

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
Way to conditionally hide rows? Cuda Excel Worksheet Functions 3 November 10th 06 03:18 PM
Conditionally formatting rows junoon Excel Worksheet Functions 4 May 29th 06 10:36 PM
retain hyperlink target when adding/deleting rows AGK New Users to Excel 3 May 23rd 06 01:59 AM
Conditionally Hiding Rows Llobid Excel Discussion (Misc queries) 5 April 11th 06 10:56 PM
Hiding Rows Conditionally Mike Hogan Excel Discussion (Misc queries) 2 December 9th 04 10:05 PM


All times are GMT +1. The time now is 06:30 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"