Advanced Sort Routine

You could add a column called Parent to the left of the Crit path column with the following formula:

=TRUNC(B4,0)  for the first row of data, then copy down.

I guess this would need adding into the AutoSort routine.

You could then use Pivot Table with Parent as a Page Field, Crit Path and task as Row fields and no Data fields.

When user then Selects the Parent in the Page field it will show the list of all children.

Thanks
Rob H

See attached.

 Sort-Routine-on-a-Excel-Column.xls

To make slightly more user friendly, you could draw a couple of buttons for increase and decrease and assign these two codes to them.

Sub Increase()

    CurrentPage = ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage
        
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage = CurrentPage + 1
    
End Sub

Sub Decrease()

    CurrentPage = ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage
    
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage = CurrentPage - 1

End Sub

Select allOpen in new window

Trying to figure out what to do if the increase goes beyond the maximum value for parent or the decrease goes below 1, I would assume you would want all displayed.

Thanks
Rob H

Why not use Excel Groups?  The attached has a button that deletes any groups that exists (these are outline groups), then re-creates based on the numbering system and collapses all groups.  You merely have to hit the plus signs on 1, or 2, or whatever to expand.  Up at the top left, you can hit 1 or 2 to expand all or collapse all.

Let me know what you think.

Here's the code:
 

Sub GroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim top As Range, bottom As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")

    On Error Resume Next
    'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
    wks.Rows.Ungroup
    
    For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
        If top Is Nothing Then
            Set top = rng
        Else
            If Int(top.Value) <> Int(rng.Value) Then
                Set bottom = rng.Offset(-1, 0)
                'now group top to bottom
                wks.Rows(top.Offset(1, 0).Row & ":" & bottom.Row).Group
                Set top = rng
                Set bottom = Nothing
            End If
        End If
    Next rng
    wks.Outline.ShowLevels RowLevels:=1
End Sub

Select allOpen in new window

See attached demo worksheet with your original setup and this macro, etc...

There's also a clearGroups macro just in case for some reason you want to clear it all via VBA.
 

Sub clearGroups()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")

    On Error Resume Next
    'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
    
    wks.Outline.ShowLevels rowlevels:=2
    wks.Rows.Ungroup

End Sub

Select allOpen in new window

Dave
Sort-Routine-on-a-Excel-Column-r.xlsm

Here's another add.  If one must have the button, rather than using the outline +'s, you can use this enhancement, which leverages group oulining, but gives you a button to iterate through as you request.  You can even turn the +'s off, but I left them there (see comments in the groupColumnA routine for how to do that.  If you unhide more than one group, then iterate, it will go with the first unhidden, and move forward from there.

Here's the code:

 

Sub IterateGroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim showX As Integer
Dim totalVisibleRows As Long, totalRows As Long

    'routine assumes groups have been set
    Application.ScreenUpdating = False
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")
        
    On Error GoTo errHandler
    'determine which is showing children, if any, then hide the rest
    For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
        If rng.EntireRow.Hidden = False And Int(rng.Value) <> rng.Value Then  'is not parent and is shown (not hidden)
            If showX = 0 Then
                showX = Int(rng.Value) + 1 'next one to show, if any - otherwise showX is zero
                'go ahead and hide it
                wks.Rows(rng.Row).ShowDetail = False
            ElseIf rng.EntireRow.Hidden = False Then 'hide all the rest
                wks.Rows(rng.Row).ShowDetail = False
            End If
        End If
    Next rng

    'Second Pass: now find the next to show, and show it
    For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
        If rng.Value <> Int(rng.Value) Then 'looking at parent
            If showX <> 0 Then 'we're showing something
                If Int(rng.Value) = showX And rng.EntireRow.Hidden = True Then 'so show it
                    wks.Rows(rng.Row).ShowDetail = True
                End If
            ElseIf wks.Rows(rng.Row).Hidden = True Then 'then show the first one
                wks.Rows(rng.Row).ShowDetail = True
                showX = Int(rng.Value)
            End If
        End If

    Next rng

    Application.ScreenUpdating = True
    Exit Sub
    
errHandler:
    'if we got here, then show detail didn't work, which means outlining is not on - make that call, now
    Call GroupColumnA
    
End Sub
Sub GroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim top As Range, bottom As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")
    
    ActiveWindow.DisplayOutline = True 'Comment this, and uncomment the next to not see the + signs on the outlining
    'ActiveWindow.DisplayOutline = False 'Uncomment this to not see the + signs on the outlining
    
    On Error Resume Next
    'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
    wks.Rows.Ungroup
    
    For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
        If top Is Nothing Then
            Set top = rng
        Else
            If Int(top.Value) <> Int(rng.Value) Then
                Set bottom = rng.Offset(-1, 0)
                'now group top to bottom
                wks.Rows(top.Offset(1, 0).Row & ":" & bottom.Row).Group
                Set top = rng
                Set bottom = Nothing
            End If
        End If
    Next rng
    wks.Outline.ShowLevels rowlevels:=1
End Sub
Sub clearGroups()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")

    On Error Resume Next
    'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
    
    wks.Rows.ClearOutline

End Sub

Select allOpen in new window

See attached demo workbook.

Enjoy!

Dave
Sort-Routine-on-a-Excel-Column-r.xlsm

Rob and Dave,

Thanks so much for responding!  Rob, appreciate your input however, I believe the approach that Dave is pursuing here is a better fit for what I'm trying to accomplish.  I have attached the actual sheet for review.  Dave, I attempted to embed your idea/code with regard to the outline approach and I run into two problems; you will see when you try to add another "Task" in the first open row down, that it does not adapt into the outline format thus rendering the sorting invalid.  Also, if you want to simply delete a row, you get a debug error.  There is probably a simple solution, I just don't have the skill to know how to fix those two errors.  I also think as you play with this, you will see how I'm trying to use it.  You input the Tasks and then build out a RASCI Matrix to assign responsibilities.

Thank you & thank you both,

B.

RASCI-Sheetv76-Sample.xlsm

Bright - does it work for you if you clear groups before you add a task or delete a task?  If so, we merely need to add that step, prior to taking an action in the event traps you have.

Dave,

Is there a way to prevent entering or deleting a row unless you "Clear Groups"?  Perhaps also adding a display a message when you try to delete or add a row?  Something like, Please "Clear Groups" prior to adding or deleting a row?  I think that would work fine.

B.

I put in a call to clearGroups before the sort, then to create groups and iterate to the group that was added, in the worksheet_change event.

See attached and let me know if this is the behavior you're looking for.

Dave
RASCI-Sheetv76-Sample-r1.xlsm

I think that took care of creating new rows.  What process do you take to delete a row?  Everytime I try, I get an error from your app.

Dave

Dave,

First of all "much thanks"!    

For deleting a row, right now I'm simply highlighting a row and using the delete function.  I'm open to suggestions on this.  Perhaps a Add/Delete button & macro?  Or something easy?

TY,

B.

Bright - try this - inserting and deleting.  Insert is done just by typing a new number at the bottom.  Deleting - I don't suggest selecting entire row unless you ensure you're not deleting other things - like the table (e.g., C:E range).  In that case, just select column A:B on the row/rows you want to delete then shift up.

The attached should accomodate deletions, now.  I used similar logic for handling (understanding when rows were being deleted in the change event) here:  http://www.dailydoseofexcel.com/archives/2006/08/21/capture-deleted-rows/

Let me know what you think!

Dave
RASCI-Sheetv76-Sample-r2.xlsm

Dave,

Thank you.  

When I try to add a row, I get an error in:

 showX = Application.WorksheetFunction.RoundDown(Target.Cells(1, 1).Value, 0) 'round to parent value

But only the first time I add a row.  Then it works fine.

Can you test that to see if you get the same error?

B.

give me the number you used for the add, and I'll check it out...

Dave

If you go to the last cell (blank) and add in, say for example, 13.75, it will put the row in the proper place, then put in data (e.g. NEW PROJECT DATA) and advance to the next cell.

The error shows;

    showX = Application.WorksheetFunction.RoundDown(Target.Cells(1, 1).Value, 0) 'round to parent value

Ty,

B.

I'm not getting your error.  I suspect you're dropping my code in another sheet?  I never see the macro >>put in data (e.g., NEW PROJECT DATA).

However, in the interim (as I can't replicate) I've trapped the error, re: ignoring it.  I also fixed a problem I didn't see earlier with new parent's being created - e.g., adding 15, etc.  Also, a couple other changes for other items I found, re: deleting rows.

So, code changes in the RASCI codepage, in ThisWorkbook and also Module1

Sorry for shotgunning this, but as a result of your error, I found a couple more conditions I needed to handle.  I still couldn't replicate your error, but did the error trap.

Let me know...

See attached,

Dave

RASCI-Sheetv76-Sample-r3.xlsm

Dave,

Sorry to be such a problem; I'm using your version 3.  When I add a new number it now puts it in the right spot.  However, it also "fetches" somehow, a dropdown box I have for validation in Column C.  

Take a look.

Much thanks,

B.

So, what's its supposed to fetch?  as I said, in my version I'd never seen it populate any data when I added...

Not sure where the validation came from.  Perhaps a test delete with shift left instead of up?  Don't think that was caused programatically.  I cleared it and ran some tests.  I think we're there.

Dave
RASCI-Sheetv76-Sample-r3.xlsm

Dave,

I think you have nailed it!  One little thing, can you have the cursor (.target?) go to the new row instead of back to the end of the column?  Also, I'm getting a beep each time I add a number/row.  I can live with it but again, may be a quick fix.

Thank you,  B.

There's No code that beeps, I promise :)

Here's your final solution.

Dave
RASCI-Sheetv76-Sample-r4.xlsm

D.,

Now I'm beginning to feel like a tester AND a whiner!  Sorry.  If you bring up your version 4 and you tab across in order to put data into col. D for example, then hit the return button, you get an error;

at this line:

addVal = Target.Cells(1, 1).Value

See if you get the same thing.

B.

Dave,

You are the man!  Sounds like you have had quite the week!  And doing EE at the same time....man....

This works great now.......

I'll play with it; do some testing and then submit another question on how to move the table somewhere else.  You're right; I just put it there on a temp. basis.

Hopefully you can use this Worksheet for your business as well.

Best regards,

B.

Fantastic work by Dave!  Much thanks to you and the other EE Professionals that have helped out in this nice Worksheet/book (Teylyn & Rorya too).  You guys are all great at what you do.

B.

Dave,

In further testing, I have several problems with the model (small bugs).  If I add a line, it appears to automatically collapse the outline.  Also, when you add the same number more then once in Column A, it doesn't refresh the horizontal table beginning in Row J.  Something isn't working correctly.  I've attached the sample.  Try adding another number in Col. A and see what happens, then go over to J and see that the horizontal row is not expanding.  

I think you are right; I need the output on another tab.

Let me know if you want me to ask this as another question.

Much thanks,

B.
Copy-of-RASCI-Sheetv76-Sample-r5.xlsm

Dave,

I tested it again, and your code worked fine!  I'm not sure what my problem is; perhaps I should not have two copies (different versions) open at once.  Apparently it works fine.  However, I have noticed two enhancements I need that were not in the original design.  1.) I need to help avoid putting the wrong text in Col. B when describing a task that already is assigned.  So I've authored another question you may want to look at (or at this point may not!!!! ;-)

https://www.experts-exchange.com/questions/27376429/Enhancing-a-RASCI-Model-to-avoid-different-input-to-same-assigned-Priority.html

Once this is complete, I'm going to author another question to put the output (as you suggested) on another sheet so as to not disrupt it incorrectly when deleting rows.

Much thanks and I hope you will participate.

B.

Ok - I will definately take a look.  I'm beat for the day - lot of outside work.  Will look tomorrow and pick up if no one else has.

Cheers,

Dave

Thanks Dave.  I know what you mean about outside work; it's grass planting time again.

Enjoy your evening.

All the best,

B.