how to delete right rows?

S

Sirritys

I have quite complicated problem. I have sheet where I have items in
rows which have many values in columns. values needed here are "level"
and "class"

Level is number value between 1-10 and Class can be "Major" / "Minor".

Now I need to select cells in the manner that if the item is classified
Major, all the cells that come right below it and have higher level
would be deleted. When we come to Item that has same or higher level
again, same procedure would start from there on. Also, only major cells
should be remaining.

So in the sample the cells with x would be only ones remaining

before:
Item Level Class
Jee 1 major
Rok 2 minor
Mar 3 major
Whii 2 major
Loks 1 minor
Mare 2 major
Arr 2 major
Parr 3 major
Roh 1 major
Moh 2 minor

after:
Item Level Class
x Jee 1 major
Rok 2 minor
Mar 3 major
Whii 2 major
Loks 1 minor
x Mare 2 major
x Arr 2 major
Parr 3 major
x Roh 1 major
Moh 2 minor

I have thought this over and over, and can't seem to find the solution.

-Sirritys
 
B

Bob Phillips

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range
Dim oArea As Range
Dim nLevel

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Do
i = i + 1
If LCase(Cells(i, "C").Value) = "major" Then
nLevel = Cells(i, "B").Value
Do
i = i + 1
If rng Is Nothing Then
Set rng = Rows(i)
Else
Set rng = Union(rng, Rows(i))
End If
Loop Until Cells(i, "B").Value = nLevel Or _
i > iLastRow
End If
Loop Until LCase(Cells(i, "C").Value) = "major" Or _
i > iLastRow

If Not rng Is Nothing Then
For Each oArea In rng.Areas
oArea.Delete
Next oArea
End If

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
S

Sirritys

Thank you. It didn't work like that, but with little tweaking it works
now.

My 1st VBA prog, yihaa!

Thanks for a very good model how to do this. helped me much with
learning the syntax of VBA.

This was the Finald product (note that major/minor has changed to
true/false):

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range
Dim oArea As Range
Dim nLevel

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Do
i = i + 1

If LCase(Cells(i, "C").Value) = "true" Then

nLevel = Cells(i, "D").Value

While (Cells(i + 1, "D").Value > nLevel And i < iLastRow)
i = i + 1

If rng Is Nothing Then
Set rng = Rows(i)
Else
Set rng = Union(rng, Rows(i))
End If

Wend

ElseIf LCase(Cells(i, "C").Value) = "false" Then

If rng Is Nothing Then
Set rng = Rows(i)
Else
Set rng = Union(rng, Rows(i))
End If

End If

Loop Until i > iLastRow


If Not rng Is Nothing Then
For Each oArea In rng.Areas
oArea.Delete
Next oArea
End If


End Sub
 
B

Bob Phillips

What looked simple at first turned out to be a little tricky. I couldn't
work bottom up as I normally do with deleting because I wouldn't know the
condition at that point, so I went top down and stored each row that met the
delete criteria.

Glad you got it working.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Top