Home > Enterprise >  Sort groups and keep spaces
Sort groups and keep spaces

Time:10-23

I'm looking for help on a code where the end user hits a button and it sorts the data, but keeps the "groups" together (from columns A through AA) as well as the spaces between tasks.

I've done some research online, but wasn't able to get anything to work, so I don't even have a base code to start from.

Here's some pictures to show what I'm trying to accomplish.

The first image shows the tasks as they may have been entered, but then we assign priorities after all tasks are entered and, as you can see, they're out of order.

enter image description here

Then I'd like for them to hit that "sort" button on the top left of the image, and it sort the worksheet base upon priority, with 1 being the first task, and going down to the last, but keep the "groups" and the space between tasks, so it ends up looking like this:

enter image description here

Again, columns affected would be from A through AA (i.e., the data needing to stay together spans between those columns).

I don't know if this is even possible, but any help would be GREATLY appreciated.

EDIT:

I created a thread on ExcelForum so I can post an actual spreadsheet... that post is here: https://www.excelforum.com/excel-programming-vba-macros/1362269-sort-groups-and-keep-spaces.html#post5585545

CodePudding user response:

Use 2 spare columns to hold sort order keys.

Option Explicit
Sub sortit()

   Dim wb As Workbook, ws As Worksheet
   Dim LastRow As Long, r As Long
   Dim p As Integer, n As Long

   Set wb = ThisWorkbook
   Set ws = wb.Sheets(1)
   With ws
        LastRow = .UsedRange.Rows.Count   .UsedRange.Row - 1

        ' use column AB,AC for sort order
        For r = 4 To LastRow
            If .Cells(r, "A") > 0 Then
                p = .Cells(r, "A")
                n = 0
            End If
            n = n   1
            .Cells(r, "AB") = p
            .Cells(r, "AC") = n
        Next

        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=ws.Range("AB4"), SortOn:=xlSortOnValues, _
                Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=ws.Range("AC4"), SortOn:=xlSortOnValues, _
                Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange ws.Range("A4:AC" & LastRow)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ' clear columns
        .Columns("AB:AC").Clear
    End With

    MsgBox "Sorted"
End Sub
  • Related