how to delete right rows?

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

Bob
Mon Jul 10 04:36:00 CDT 2006

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)

"Sirritys" <aki.koikkalainen@hotmail.com> wrote in message
news:1152518982.578838.217610@s13g2000cwa.googlegroups.com...
> 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
>

Sirritys
Tue Jul 11 00:50:24 CDT 2006

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

Bob
Tue Jul 11 02:27:58 CDT 2006

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)

"Sirritys" <aki.koikkalainen@hotmail.com> wrote in message
news:1152597024.787242.131050@b28g2000cwb.googlegroups.com...
> 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
>