Solved

Advanced Sort Routine

Posted on 2011-09-29
29
172 Views
Last Modified: 2012-05-12
EE Professionals,

I have a column that represents an outline (Col. A) grouping; it has an "auto sort" macro that when you add a new line it will auto insert a row of data (A:E).  I am looking for a specific macro that looks at Column A, and as you click the button, it shows you the whole number and it's associated subset -- it's "children" (e.g. 1, 1.1, 1.2) and show that group only; keep in mind that I need the ability to put another row in, (e.g. 1.3), in the blank column that is actually the first blank row in the list, and it will accommodate the new addition.  By clicking the button, you will see 1 and it's "children", then click it again, and see 2 and it's children, etc. etc. until it gets to the end and shows the entire column again.

Much thanks in advance.

B.
Sort-Routine-on-a-Excel-Column.xlsx
0
Comment
Question by:Bright01
  • 13
  • 13
  • 3
29 Comments
 
LVL 31

Expert Comment

by:Rob Henson
ID: 36816088
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
0
 
LVL 31

Expert Comment

by:Rob Henson
ID: 36816108
0
 
LVL 31

Expert Comment

by:Rob Henson
ID: 36816264
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

Open 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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36819110
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

Open 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

Open in new window

Dave
Sort-Routine-on-a-Excel-Column-r.xlsm
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36889993
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

Open in new window

See attached demo workbook.

Enjoy!

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

Author Comment

by:Bright01
ID: 36890405
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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36891449
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.
0
 

Author Comment

by:Bright01
ID: 36891576
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36891634
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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36891640
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
0
 

Author Comment

by:Bright01
ID: 36891665
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36891817
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
0
 

Author Comment

by:Bright01
ID: 36892117
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.




0
 
LVL 41

Expert Comment

by:dlmille
ID: 36892122
give me the number you used for the add, and I'll check it out...

Dave
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 

Author Comment

by:Bright01
ID: 36892479
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36892666
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
0
 

Author Comment

by:Bright01
ID: 36892998
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36893026
So, what's its supposed to fetch?  as I said, in my version I'd never seen it populate any data when I added...
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36893111
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
0
 

Author Comment

by:Bright01
ID: 36893141
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36893211
There's No code that beeps, I promise :)

Here's your final solution.

Dave
RASCI-Sheetv76-Sample-r4.xlsm
0
 

Author Comment

by:Bright01
ID: 36893315
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.
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 36893899
Sorry about that.  With meetings this morning and catching a plane, coupled with new code from your workbook, that I didn't have last night -  I didn't check enough before posting.  

Also >>can you have the cursor (.target?) go to the new row instead of back to the end of the column?    
spur of the moment requests like these sometimes get spur of the moment responses.  

Here's your super-enhanced, slick, ultra tested solution.

PS - I can see a need to move your RASCI table somewhere else, I think.  The hiding of rows kind of messes up your work to the right, thus new rows you add in RASCI could really be all over the place, depending on the hidden/unhidden state of rows.

Here's the solution.

Dave
RASCI-Sheetv76-Sample-r5.xlsm
0
 

Author Comment

by:Bright01
ID: 36893973
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.
0
 

Author Closing Comment

by:Bright01
ID: 36893984
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.
0
 

Author Comment

by:Bright01
ID: 36900690
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
0
 

Author Comment

by:Bright01
ID: 36900893
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!!!! ;-)

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27376429.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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36901037
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
0
 

Author Comment

by:Bright01
ID: 36901046
Thanks Dave.  I know what you mean about outside work; it's grass planting time again.

Enjoy your evening.

All the best,

B.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now