Help, there must be a better way!

K

Kobayashi

I've been trying all day to crack this without success. Any help would
be very much appreciated!

Here is my code. There must be a better way, using either a look-up
table or Select Case statement to do this but I'm not yet experienced
enough to work it out.
The below works, to a point, until it starts deleting the rows! Then,
because it shifts the row up it jumps a row so I need a way to address
this using some kind of statement?


lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set myRange = WorCtrlsheet.Range("b2", Cells(lLastRow, "b"))
With myRange

For Each Cell In myRange

If Cell.Value <> "Criteria 1" And _
Cell.Value <> "Criteria 2" And _
Cell.Value <> "Criteria 3" And _
Cell.Value <> "Criteria 4" And _
Cell.Value <> "Criteria 5" And _
Cell.Value <> "Criteria 6" And _
Cell.Value <> "Criteria 7" And _
Cell.Value <> "Criteria 8" And _
Cell.Value <> "Criteria 9" And _
Cell.Value <> "Criteria 10" And _
Cell.Value <> "Criteria 11" And _
Cell.Value <> "Criteria 12" And _
Cell.Value <> "Criteria 13" And _
Cell.Value <> "Criteria 14" Then

Cell.EntireRow.Delete

End If
Next i
 
J

J.E. McGimpsey

I think I'd try something like:

Dim critArray As Variant
Dim delRange As Range
Dim cell As Range
Dim myRange As Range
Dim bFound As Boolean

critArray = Array("Criteria 1", "Criteria 2", "Criteria 3", _
"Criteria 4", "Criteria 5", "Criteria 6", _
"Criteria 7", "Criteria 8", "Criteria 9", _
"Criteria 10", "Criteria 11", "Criteria 12", _
"Criteria 13", "Criteria 14")

With WorCtrlSheet
For Each cell In .Range("B2:B" & _
.Cells.SpecialCells(xlCellTypeLastCell).Row)
With cell
bFound = False
For i = LBound(critArray) To UBound(critArray)
If .Value = critArray(i) Then
bFound = True
Exit For
End If
Next i
If Not bFound Then
If delRange Is Nothing Then
Set delRange = .Cells
Else
Set delRange = Union(delRange, .Cells)
End If
End If
End With
Next cell
End With
If Not delRange Is Nothing Then delRange.EntireRow.Delete

Since VBA does each comparison in an If...Then statement, as long as
the values were evenly distributed, I'd expect the loop to take no
longer than the straightline method.

In building a range of cells to delete, all the cells can be deleted
at once, eliminating the problem with XL renumbering rows.
 
T

Tom Ogilvy

lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set myRange = WorCtrlsheet.Range("b2", Cells(lLastRow, "b"))
With myRange

For i = lLastRow to 2 step - 1
set cell = WorCtrlSheet.Cells(i,2)
If Cell.Value <> "Criteria 1" And _
Cell.Value <> "Criteria 2" And _
Cell.Value <> "Criteria 3" And _
Cell.Value <> "Criteria 4" And _
Cell.Value <> "Criteria 5" And _
Cell.Value <> "Criteria 6" And _
Cell.Value <> "Criteria 7" And _
Cell.Value <> "Criteria 8" And _
Cell.Value <> "Criteria 9" And _
Cell.Value <> "Criteria 10" And _
Cell.Value <> "Criteria 11" And _
Cell.Value <> "Criteria 12" And _
Cell.Value <> "Criteria 13" And _
Cell.Value <> "Criteria 14" Then

Cell.EntireRow.Delete

End If
Next i
 
T

Tom Ogilvy

forgot to delete the With statement

Dim cell as Range
Dim lLastRow as Long
With WorCtrlSheet
lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
End With


For i = lLastRow to 2 step - 1
set cell = WorCtrlSheet.Cells(i,2)
If Cell.Value <> "Criteria 1" And _
Cell.Value <> "Criteria 2" And _
Cell.Value <> "Criteria 3" And _
Cell.Value <> "Criteria 4" And _
Cell.Value <> "Criteria 5" And _
Cell.Value <> "Criteria 6" And _
Cell.Value <> "Criteria 7" And _
Cell.Value <> "Criteria 8" And _
Cell.Value <> "Criteria 9" And _
Cell.Value <> "Criteria 10" And _
Cell.Value <> "Criteria 11" And _
Cell.Value <> "Criteria 12" And _
Cell.Value <> "Criteria 13" And _
Cell.Value <> "Criteria 14" Then

Cell.EntireRow.Delete

End If
Next i

--
Regards,
Tom Ogilvy


Tom Ogilvy said:
lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set myRange = WorCtrlsheet.Range("b2", Cells(lLastRow, "b"))
With myRange

For i = lLastRow to 2 step - 1
set cell = WorCtrlSheet.Cells(i,2)
If Cell.Value <> "Criteria 1" And _
Cell.Value <> "Criteria 2" And _
Cell.Value <> "Criteria 3" And _
Cell.Value <> "Criteria 4" And _
Cell.Value <> "Criteria 5" And _
Cell.Value <> "Criteria 6" And _
Cell.Value <> "Criteria 7" And _
Cell.Value <> "Criteria 8" And _
Cell.Value <> "Criteria 9" And _
Cell.Value <> "Criteria 10" And _
Cell.Value <> "Criteria 11" And _
Cell.Value <> "Criteria 12" And _
Cell.Value <> "Criteria 13" And _
Cell.Value <> "Criteria 14" Then

Cell.EntireRow.Delete

End If
Next i
Click to expand...
 
H

Harald Staff

Hi

I'd use Select case here -added to Tom's downwards-up loop. Perhaps faster solutions
exist, but this one is easy to read and maintain.

Select Case Cell.Value
Case "Beer"
Case "Wine"
Case "Jack Daniels"
Case Else
Cell.EntireRow.Delete
End Select
 
K

Kobayashi

Tom, J.E and Harold,

Many thanks to you all for your help! I can't wait to try the code out
at work tomorrow!

Harold, All,

I did try a Select Case but couldn't get it to work so am really
looking forward to trying to get this to work with the other code
kindly provided. However, is there any chance of elaborating a little
on how I should do this? I'm kind of semi-comfortable with using If
functions in For... and For each statements but haven't yet tried using
a Select Case with them.

I also now understand that to address the row deletion issue you simply
have to run the code 'backwards' so that you start from the last row in
the range to the first. Thanks! Unless you adopt J.E.'s approach of
course which I am also keen to try out!

Finally, I can see that using Select Case is far easier to understand
that what I wrote but wouldn't some kind of lookup to a list of values
be better still and easier to maintain? I appreciate that that's not
what I submitted.

Many thanks again for your help. This site and, more importantly, those
of you who help us struggling/beginner programmers, speed our learning
and understanding tremendously!

Thanks again and apologies for War and Peace part 2!

Adrian
 
H

Harald Staff

Hi Adrian

Re Select case, please post your non-working code. Theory; sorry if you already know this,
Select case works like this in pseudo-code:

Select Case Weather
Case Rain
Wear raincoat
Case Dry Cold
Wear warm sweater
Case Tropical
Bring towel & wear nothing
Case Else
Wear Jeans and T-shirt
End Select

Trick is; it's picky, just like a list lookup would also be. If you threaten someone to
explicitly enter "Coffee" or "Beer" only, bet anything that some fool will still enter
"Both" (easy to spot) or "Beer " (note the trailing space, impossible to spot). So
underestimate your raw data and your user, code for any exception and variation, and do
always have a "Case else" to avoid burning computers. Nothing is easy, but some things are
easier to maintain after the problems have been solved
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Advice rather than an actual question. 6
Cell reference being changed to a specific criteria in IF formula...HELP! 0
Pivot Table Code - Is there a better way? 2
helllp! 0
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/PATTERN CELL 5
please help with my code below 4
Array or Pivot Tables??? 1
Finding the minimum value in a list but excluding zeros - a variationon an old problem 10

Top