Reduce rows according to cell values

Hello All!

I have a quite special problem here (Well at least for me ).

So the basic idea would be, that you can select any cell, it will copy the current row on a new sheet. Then it would list all first other rows, which have a lower level value then i have selected. After this, it would copy all other levels, whicch have higher level value and are after the current row. So this would make a more visible hierarchy for me.

So i started with this:

ActiveSheet.Cells(activecell.Row, 1).Select
currlvl = activecell.value

So i have the current level in a variable.

And then I got stuck. Here I should make the macro run backwards and search for the first cell in the same column, which has lower value then the currlvl. Copy that row to the other sheet, change currlvl to new and move on to the next level which is lower, copy again etc. The thing is, that i have no idea, what command i should use here. for or loop or something i dont even know?

I have made a screen of original list and desired result, and I attached an excel file also with it.

reduce.jpg
reduceline.xlsx


This would help me a loooooot, could you Masters help me?

Thank you in advance,

Ambrus

I pretty much started to look backward with the following:

Sub back()

Dim x, n, i As Integer

x = activecell.Row

For n = x To 1 Step -1
Cells(n, 5).Select
activecell.FormulaR1C1 = "yaaay"

Next

End Sub


Seems i can list the if statements within this then.

Hi All,

I might be not the prettiest problem solving formula, but this works for me just fine. Thought if someone would be interested in a similar problem, could use my source code. Here it goes:

If you have nicer solutions, feel free to post it.

Sub refer()

Dim lRow, end, puffer, pufferdown, lowerlvl, nextlvl, currlvl, x, n, i As Integer
Dim need As String

Application.ScreenUpdating = False

lRow = Range("A" & Rows.Count).End(xlUp).Row

x = activecell.Row

Cells(x, 25).Select
        activecell.FormulaR1C1 = "needed"
puffer = ActiveSheet.Cells(activecell.Row, 1)
pufferdown = ActiveSheet.Cells(activecell.Row, 1)
end = 0


For n = x To 2 Step -1

currlvl = Cells(n, 1)
lowerlvl = Cells(n - 1, 1)
kell = Cells(n, 25)

    If lowerlvl < currlvl Then
               
        If lowerlvl >= puffer Then
            Cells(n - 1, 25).Select
            activecell.FormulaR1C1 = "not needed"
        End If
        
        If lowerlvl < puffer Then
            Cells(n - 1, 25).Select
            activecell.FormulaR1C1 = "needed"
            puffer = lowerlvl
        End If
        
        
    End If
    
    If lowerlvl >= currlvl Then
        
        Cells(n - 1, 25).Select
        activecell.FormulaR1C1 = "not needed"
    
    End If
Next

For n = x To Cells(Rows.Count, "A").End(xlUp).Row

currlvl = Cells(n, 1)
nextlvl = Cells(n + 1, 1)
need = Cells(n, 25)

    
    If nextlvl <= pufferdown Then
        Cells(n + 1, 25).Select
        activecell.FormulaR1C1 = "not needed"
        vege = 1
    End If
          
    If nextlvl > pufferdown Then
        Cells(n + 1, 25).Select
        activecell.FormulaR1C1 = "needed"
    End If
    
    If vege = 1 Then
        Cells(n + 1, 25).Select
        activecell.FormulaR1C1 = "not needed"
    End If
Next

Cells(1, 25).Select
        activecell.FormulaR1C1 = "Refer"

Range("Y1").Select

Selection.AutoFilter

  ActiveSheet.Range("$A$1:$Y$" & lRow).AutoFilter Field:=25, Criteria1:="=needed"
    
Range("A1").Select

End Sub

Regards,

Ambrus