Avatar of dkcoop03
dkcoop03Flag for United States of America

asked on 

Scripting for Excel VBA 5 level sort

I have part of a complex sort done.  I'm attaching the spreadsheet and code so far.  I basically need a 5 level sort.  Categories with a minus "-" in front (col A) of them expand to contain sub categories -- they can also have a plus "+" in front of them indicating that they are rolled up.  If there is a space " " in column A that indicates a category with no subcategories.  I need to sort the sub categories within the categories and then sort every category against other categories.  I have that part done.  The complexity comes because there can be sub sub categories, or another level of category within the sub category.  In that case I want those categories sorted within the sub category.  So I somehow need to test both column A and column B for the +, - or space.  So I'm wondering first, is my code the best way to do this (It does work for sub categories and categories) and second, how to incorporate the testing for sub sub categories.  I'm using Excel 2010.  Thanks
Private Sub cmdSort_Click()
Dim r As Range
Dim s As Range
Dim sign As Range

Dim lastrow As Integer
Dim catcount As Double
Dim catcount2 As Double

lastrow = Range("E3").End(xlDown).Row
catcount = lastrow

Set r = Range("G3")
Set s = Range("H3")
Set sign = Range("A3")
Set subsign = Range("B3")

While r.Row <= lastrow
    If sign.Value <> "" Then
        s.Formula = catcount + 0.1
        r.Formula = r.Offset(0, -2).text
        catcount2 = catcount
        catcount = catcount - 1
    Else   'populate cell with value in cell above
        r.Formula = r.Offset(-1, 0).text
        s.Formula = catcount2
    End If
    'drop down one row
    Set s = s.Offset(1, 0)
    Set r = r.Offset(1, 0)
    Set sign = sign.Offset(1, 0)
Wend

Call FourKeySort

End Sub

Sub FourKeySort()

    SortAll "H3"
    SortAll "G3"
    SortAll "J3"
    SortAll "I3"
    SortAll "E3"

End Sub

Sub SortAll(x As String)

    Range(x).Sort _
        Key1:=Range(x), _
        Order1:=xlDescending, _
        Header:=xlNo
End Sub

Open in new window

testsort.xlsx
Microsoft ExcelMicrosoft Applications

Avatar of undefined
Last Comment
dkcoop03
Avatar of Juan Ocasio
Juan Ocasio
Flag of United States of America image

I'm wondering why you can't use the builtin sort function and just add 5 levels?
Avatar of dkcoop03
dkcoop03
Flag of United States of America image

ASKER

Because the boss wants the user to be able to click a button and have this sort automatically
Avatar of gyetton
gyetton
Flag of United Kingdom of Great Britain and Northern Ireland image

could you use scenarios, i.e. use the built in sort facilities and then save it as a custom view.
create one view call 'normal', one called 'sorted' the user can then just choose which view they want.
How yo do that depends on version in 2007 it is view / custom view, in previous versions i think it was called scenarios, but i can't remember (sorry)
Avatar of dkcoop03
dkcoop03
Flag of United States of America image

ASKER

I don't think that's an option.  Is this not doable in code?
Avatar of dkcoop03
dkcoop03
Flag of United States of America image

ASKER

I guess when I asked if there was a better way to do this I meant a better way to code it
Avatar of gyetton
gyetton
Flag of United Kingdom of Great Britain and Northern Ireland image

OK I think you have over complicated this.
i would fill the gaps
sort it (I have merely copied and pasted a recorded macro or the sorting so you will need to edit that code
'un' fill the gaps
as per this code...
Sub MyCode()
Dim y As Long
    y = Cells(2, 5).End(xlDown).Row
    FillGaps y
    Sort
    UnFillGaps y
End Sub

Sub FillGaps(yMax As Long)
    yMax = Cells(2, 5).End(xlDown).Row
    For y = 3 To yMax
        If Cells(y, 2) = vbNullString Or Cells(y, 2) = "-" Then
            Cells(y, 2) = Cells(y - 1, 2)
            If Cells(y, 3) = vbNullString Then
                Cells(y, 3) = Cells(y - 1, 3)
            Else
                Cells(y, 4) = "#"
            End If
        Else
            If Cells(y, 3) = vbNullString Then
                Cells(y, 3) = "#"
                Cells(y, 4) = "#"
            Else
                Cells(y, 4) = "#"
                Cells(y, 3) = Cells(y - 1, 3)
            End If
        End If
    Next
End Sub
Sub Sort()
    Range("B2:L26").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("B3:B26") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("C3:C26") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("D3:D26") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("B2:L26")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub UnFillGaps(yMax As Long)
Dim y As Long
Dim cat1 As String
Dim cat2 As String
    Cells(3, 1).Resize(yMax, 1).Clear
    Selection.Replace What:="#", Replacement:=vbNullString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    For y = 3 To yMax
        If Cells(y, 2) = Cells(y - 1, 2) Or Cells(y, 2) = cat1 Then
            If Cells(y, 3) = Cells(y - 1, 3) Or Cells(y, 3) = cat2 Then
                cat2 = Cells(y, 3)
                Cells(y, 2) = vbNullString
                Cells(y, 3) = vbNullString
            Else
                If Cells(y, 3) = Cells(y + 1, 3) Then
                    Cells(y, 2) = "-"
                Else
                    Cells(y, 2) = vbNullString
                End If
            End If
        Else
            cat1 = Cells(y, 2)
            If Cells(y, 2) = Cells(y + 1, 2) Then
                Cells(y, 1) = "-"
            End If
        End If
    Next
End Sub
Avatar of gyetton
gyetton
Flag of United Kingdom of Great Britain and Northern Ireland image

oops sorry i should have put that in a code block

some extra comments, I ignored column A for sorting and just re-populated it when unfilling the rest.
i put # into blank cells because i knew it would sort before any cells with text in them.
so basically fill puts in a # of the value above
sort as i said is a recorded macro so you will need to 'fiddle' with the range selcetion
and unfill takes out all the #'s and then all the duplicated text putting - in where necessary
Avatar of dkcoop03
dkcoop03
Flag of United States of America image

ASKER

This is a very interesting approach.  It looks like you're sorting on Columns A,B & C though.  I want to sort on column "Change" within each subsub category, and then within each sub category and and then within each category.   I need to sort the CHANGE value within each category -- keeping the items together by category.  And I also need to keep that sign with each category.  I ran your code on the worksheet and it didn't appear to sort anything so I'm not sure what it's doing.
Avatar of gyetton
gyetton
Flag of United Kingdom of Great Britain and Northern Ireland image

sorting columns BC&D,
clearing column A and then putting the -'s back where a category in column B has more than one row, like wise for column B if column C has sub categories.
try using F8 to step through the code

Excel's inbuilt sort will be much quicker than any VBA sort, so the idea is that by filling the gaps when Excel does the sorting it will automatically keep all the rows for each category, and sub category together.
The hard part was actually taking out all the extra bits i put in.
hmm if they were formatted (say red) then it would probably be easy to find all red cells and remove the contents, however you would still have to be careful especially putting the -'s back into column B
ASKER CERTIFIED SOLUTION
Avatar of gyetton
gyetton
Flag of United Kingdom of Great Britain and Northern Ireland image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of dkcoop03
dkcoop03
Flag of United States of America image

ASKER

I ended up using some math logic to keep all of the categories together and then just concatenated fields and sorted on the concatenated field.  Sorry it took so long to get back to you but I am just now getting back to this.
Microsoft Excel
Microsoft Excel

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

144K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo