Insert Row VBA HELP!

[RJK1988]

I am trying to build a traversal tree in excel. In columns A and B I have all of the relationships defined. ie (13,27) 13 being the predecessor and 27 being the successor. I am using the below array function to index and show each of the paths through the schedule.

=IF(ISERROR(INDEX($A$1:$B$1006,SMALL(IF($A$1:$A$1006=$E$3,ROW($A$1:$A$1006)),ROW(1:1)),2)),"",INDEX($A$1:$B$1006,SMALL(IF($A$1:$A$1006=$E$3,ROW($A$1:$A$1006)),ROW(1:2)),2))

the problem I am running into is that this function will show multiple results (so for example activity 299 has two successors). So I can either space out all of the cells to create this worksheet but ideally, I would like to create a VBA or function that would detect if the cell has a value in it and insert a new row underneath copying to formulas down.

I know how to use macros however I am a beginner at writing them. If someone could help me write one I would be much appreciative.

If it would make it easier I can also email a copy of the worksheet

 

[tweedle]

Welcome to the board.

Not understanding exactly what your layout is; here's a relatively generic loop to test a range of cells, and insert a row.
The code below can go in a Module by itself or the ThisWorkbook module

Test on a COPY of your workbook.
Beware the formulas with the absolute references as they get copied.

Sub RowReplicator()
    
    'Adjust these as needed
    Const TopRow = 3            'Top Row to evaluate
    Const Col = 2               'Column number to evaluate
    
    Dim LR, RowIdx As Long      'LastRow of data
    Dim ws As Worksheet
    Dim Rng, Cell As Range
    Set ws = ThisWorkbook.ActiveSheet
    
    '***************************************
    'Alternate forms
    'Set ws = ThisWorkbook.Sheets(1)
    'Set ws = ThisWorkbook.Sheets("Sheet1")
    '***************************************
    
    ws.Activate
    With ws
    'Uncomment the below to turn off screen flicker
    'Application.ScreenUpdating = False
        'Determine the last row
        LR = ws.Cells(.Rows.CountLarge, Col).End(xlUp).Row
        
        'Set a range to work in
        Set Rng = Range(Cells(TopRow, Col).Address, Cells(LR, Col).Address)
        'For Each Cell in the working Range
        For Each Cell In Rng
            
            'Evaluate the cell "detect if the cell has a value in it"
            '***************************************
            'You will likely need to adjust this
            '***************************************
            If Cell <> "" Then
                'If it passes evaluation
                'Copy the Row to a new row
                Rows(Cell.Row).Copy
                Rows(Cell.Row + 1).Insert Shift:=xlDown
                Application.CutCopyMode = False 'Turn off the selector rectangle
            End If
        Next Cell
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[RJK1988]

Thank you!, Its very close to working.

The only thing is that it keeps copying infinitely. I'm a VBA greenhorn still working my way through books to learn this code. How would I make it stop after a maximum of 16 rows?

 

[tweedle]

That would be a problem....

This version flips the method around to loop through the rows from the bottom up and should resolve the issue.

It's essentailly looking for the last row of data in Column 2(B).
From there it starts looping up to TopRow (I have set to 3); comparing for the <> "". If that's the case, then copy that row.

Sub RowReplicator()
    
    'Adjust these as needed
    Const TopRow = 3            'Top Row to evaluate
    Const Col = 2               'Column number to evaluate
    
    Dim LR, RowIdx As Long      'LastRow of data
    Dim ws As Worksheet
    Dim Cell As Range
    Set ws = ThisWorkbook.ActiveSheet
    
    '***************************************
    'Alternate forms
    'Set ws = ThisWorkbook.Sheets(1)
    'Set ws = ThisWorkbook.Sheets("Sheet1")
    '***************************************
    
    ws.Activate
    With ws
    'Uncomment the below to turn off screen flicker
    'Application.ScreenUpdating = False
        'Determine the last row [based on: Const Col = ]
        LR = ws.Cells(.Rows.CountLarge, Col).End(xlUp).Row
        
        'Loop through the rows starting at the bottom and working up
        For RowIdx = LR To TopRow Step -1
        
            'Evaluate the cell "detect if the cell has a value in it"
            '***************************************
            'You will likely need to adjust this
            '***************************************
            If Cells(RowIdx, Col) <> "" Then
                'If it passes evaluation
                Set Cell = Cells(RowIdx, Col)
                'Copy the Row to a new row
                Rows(Cell.Row).Copy
                Rows(Cell.Row + 1).Insert Shift:=xlDown
                Application.CutCopyMode = False 'Turn off the selector rectangle
            End If
        Next RowIdx
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[RJK1988]

Sorry for the delay and thank you very much for the response. After playing around with the first VBA you posted I got it to stop looping infinitely. But I'm still not having much success in what I'm trying to do. This would be much easier if I could share the workbook with you so you can see it.

The Data Sheet of my Workbook looks like this

Activity Predecessor
0 1
1 2
1 4
2 3
2 5
2 6
3 23
3 24
4 5
5 7
5 10... and so on through to...
666 674

From these (A,B) relationships I am trying to finding all the paths through to the end from any chosen starting point so for example if you chose 0 as your starting point it would go something like this

Path 1.) 0 > 1 > 2 > 3 > 23 > 24 > ......
Path 2.) 0 > 1 > 2 > 5 > 7
Path 3.) 0 > 1 > 2 > 6> 682 .....

Or if you input 2 as the starting point:

Path 1.) 2 > 3 > 23 > 24 > ......
Path 2.) 2 > 5 > 7
Path 3.) 1 > 2 > 6> 682 .....

I came up with the array function in the first post that searches and returns multiple results for those Activities with multiple predecessors. This was great and would work fine if the schedule was strictly linear however I also need to list the predecessors of the multiple results.

So in a sense, you could think of it as a Family Tree with singular parents. I'm stuck at how to automate this process though because the number of predecessors is always a variable between 0-16.

This project is extremely frustrating for me at this point so if your up for a challenge I can send you the workbook (macros free of course) so you can see what I'm actually working with. I'll give you my email in a private message