asked on

How to sort sections on Excel worksheet with VBA

I have a worksheet (attached) that has three sections. I want to sort the first section by the last column (Sort Column) Column G. So I will sort A2:G17 using column G. Then I want the next two sections to be in the same order as the first section. The code for sorting the first section is as follows:
Private Sub cmdSort_Click()
Dim r As Range

Dim lastrow As Integer
Dim row As Integer
Dim lrow As Integer
Dim newval As String
Dim sortval As String
Dim tostring As Range

'Hardcode all this stuff for now

'GET LAST ROW FOR COUNTS
lastrow = Range("B2").End(xlDown).row
row = 2
lrow = 2

'Hardcode all this stuff for now
Set r = Range("H2")

Set tostring = Range("I2")

'CLEAR ALL RANGES USED FOR SORT
Range("A2:I17").ClearContents

While r.row <= lastrow
newval = Format$((r.Offset(0, -2).Value + 2000) * 100, "00000000")
r.Formula = newval
sortval = Format$(r.Formula, "00000000")
tostring.NumberFormat = "@"
tostring.Formula = sortval

'drop down one row on all ranges
Set r = r.Offset(1, 0)
Set tostring = tostring.Offset(1, 0)
Wend

Call sortall(lastrow)

Range("h2:I17").ClearContents
End Sub
Private Sub sortall(lastrow As Integer)
Range(("2:" & lastrow)).Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlNo
End Sub

This is code that I used for another sort and I had to do the addition and leading zeros to overcome some negative number problems. This code works for the first section. My question is, now how do I sort the 2nd & 3rd sections to be in the order of the first section? Also, I'm sure there is a better way to sort the first section so any suggestions would be appreciated.

Also, I must do this in VBA since I need the sort to be done on a button click.
Thanks,
testworksheetforsort.xlsx

dlmille

I re-wrote the original sort. Created a helper Column on subsequent ranges, using MATCH function, to obtain the rank order of the original sort using the index of the rows in the section being sorted, then sorted on that column, cleaning up the helper when done. The app is designed to work for any sized block - rows or columns, as long as everything starts on range A1 with a header only on row 1, and there's at least one blank line between blocks. I even created a Reset subroutine to set everything back up sorted on the index in column A.

Here's the primary code:

Public Sub cmdSort_Click()
Dim wks As Worksheet
Dim wkb As Workbook
Dim rngToSort As Range
Dim keyRng As Range
Dim nextSort As Range
Dim helpSortCol As Range
Dim originalSort As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")
    
    'Sort first section
    wks.Sort.SortFields.Clear
    Set rngToSort = wks.Range(wks.Range("A1"), wks.Range("A1").End(xlToRight).End(xlDown))
    Set keyRng = Range(wks.Range("A1").End(xlToRight).Offset(1, 0), wks.Range("A1").End(xlToRight).Offset(1, 0).End(xlDown))
    
    Set originalSort = wks.Range(wks.Range("A2"), wks.Range("A2").End(xlDown))
    
    rngToSort.Sort Key1:=keyRng, Order1:=xlDescending, Header:=xlNo
    
    'sort second, third, and any other subsequent sections
    
    Set nextSort = wks.Range("A1").End(xlDown).End(xlDown) 'assumes next section separated by at least one blank line
    
    While nextSort.row <> wks.Range("A" & wks.Rows.Count).row
    
        Set nextSort = wks.Range(nextSort, nextSort.End(xlToRight).End(xlDown))
        
        'create helper column from original sort
        Set helpSortCol = nextSort.End(xlToRight).Offset(, 1).Resize(nextSort.Rows.Count)
        helpSortCol.Cells(1, 1).Formula = "=MATCH(A" & helpSortCol.Cells(1, 1).row & "," & originalSort.Address & ",0)"
        helpSortCol.FillDown
        
        'now sort the section
        Set rngToSort = Union(nextSort, helpSortCol) 'use the helper (last column) to sort
        
        rngToSort.Sort Key1:=helpSortCol, Order1:=xlAscending, Header:=xlNo
        
        'cleanup helpercolumn
        helpSortCol.ClearContents
        
        'setup for next sort, until done
        Set nextSort = nextSort.End(xlDown).End(xlDown)
    Wend
    
End Sub

Open in new window

See attached demo workbook.

Enjoy!

Dave
testworksheetforsort-r2.xlsm

Rob Henson

How about an alternative approach? See attached.

I have copied the data to a separate sheet with the blocks of data alongside each other so that the matching data from each block is in a single row each. Then apply the sort to the whole of this data, simple sort on one column will affect all columns selected.

Then on the report sheet use direct links to the data sheet for the row 'header' eg index and use this as a lookup to pull the relevant data from the data tab. Once created these links will stay the same even if the data is resorted, ie the reference to row 3 sya will stay as row 3 and won't move to the row in which the data previously in row 3 has moved after the sort (hope that makes sense?).

For second and third section use a link to the equivalent rows in the first section and then a lookup for the data columns.

The offset for all the lookups will be referring to the column number on the data sheet. In my example attached, I have left the row header fields and these are counted as columns in the offset, as are blank columns. If the second and third set of data had uniquely identifiable headers, you would be able to use MATCH on the header to generate the offset value.

With this approach the sort routine would now only apply to one area on the data sheet, columns A to W in my example, and would be one column as before.

Hope this helps.

Thanks
Rob H

One added note, I deleted a couple of rows between sections 2 & 3 to enable simpler copying of the formulas between sections.
testworksheetforsort.xls

dkcoop03

ASKER

Dave, I like your approach (I've learned some new syntax!). I'm not able to click the cmdButton to get it to work though so I had to do an alt-F11 and step through. The only problem I'm having with it is that the last two rows are sorting correctly in the first section but incorrectly in the second and third sections and I can't figure out why. Any ideas?

dlmille

Is it working in the example I uploaded? Is Calculation Turned on?

Let's put an application.Calculate in there:

See attached.

If it still goes awry, please share a screenprint of the data or share data (if non confidential or obfuscated).

Dave
testworksheetforsort-r3.xlsm

dkcoop03

ASKER

This is what happens when I click the Sort it button. Excel creates another workbook (I can see that it did in my task bar). Then when I click the button again I get the This worksheet is already open..... So when I click Read Only I get this: Cannot run the macro.....The macro may not be available in this workbook or all macros may be disabled. I DO have macros enabled. But I'll go ahead and test it with Alt-F11

dlmille

Save the workbook to a folder or your desktop (a trusted location) before opening it. There's no code in here that opens files so its the way you're going about it, I think.

Dave

dkcoop03

ASKER

I'm going to try and attach the spreadsheet after the application.calculate. It didn't make any difference. I left the HelpSortCol on (I didn't clear the contents) and it is 1-16 as it should be for the two sections. However, on the first section, row 16 is 3090 Back and row 17 is 3120 Equipment and this is the correct sort order. On the two subsequent sections, everything is correct except that on the second section row 34 is 3120 Equipment and row 35 is 3090 Back. This is also how the 3rd section is -- row 54 is 3120 Equipment and row 55 is 3090 Back. I'm giving you this detail in case I can't attach the spreadsheet.
testworksheetforsort-r3-1-.xlsm

dkcoop03

ASKER

It is saved on my desktop. It's not a big deal as long as I can run the code through the editor

dlmille

Here's a version with Active-X buttons rather than forms buttons. I still believe from what you're describing, that you're running from a non-trusted area.

Excel Options - Trust Center->Trust Center Settings and ensure your folders/desktop are listed so you can run macros that are saved there...

Any rate, I know this isn't a big issue for you, but want to ensure I relay the knowledge.

Dave

dlmille

Version with ActiveX buttons uploaded here.

Dave
testworksheetforsort-r4.xlsm

dkcoop03

ASKER

I made desktop trusted and opend r3 but got slapped for unrecognizable content which looked like it was the cmd buttons. The ActiveX version works just fine except for the Sort discrepancies between the sections that I mentioned before.

dlmille

Ok - help me please. are the sort disrepancies with this sheet, or new data??

dave

dkcoop03

ASKER

well, they were on this sheet. So I moved some rows around on the first section to see if it was still happening and yes, somehow the match is not working. The sort on the first section works great but the next two sections are not changing to match the first section. I'm attaching the latest. You can see that the first section sorts as it should but the 2nd section should be Ancillary, Home Goods, Nursing, Other, etc... I've been running this through and haven't found anything so I'm wondering if its in the MATCH.

I've also your code in some other data and it's doing the same thing. Sorting the first section but not matching the next two.
testworksheetforsort-r5.xlsm

dlmille

I see the problem. It was staring me in the face! I was matching on the Column A Index, rather than the category name.

Here it is, repaired. See comments on sort by category - that's what you'd change if it were another column in future - two statements that have comments on sort by category

Public Sub cmdSort_Click()
Dim wks As Worksheet
Dim wkb As Workbook
Dim rngToSort As Range
Dim keyRng As Range
Dim nextSort As Range
Dim helpSortCol As Range
Dim originalSort As Range
Dim xCalc As Long

    xCalc = Application.Calculation
    
    Application.Calculation = xlCalculationAutomatic
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")
    
    'Sort first section
    wks.Sort.SortFields.Clear
    Set rngToSort = wks.Range(wks.Range("A1"), wks.Range("A1").End(xlToRight).End(xlDown))
    Set keyRng = Range(wks.Range("A1").End(xlToRight).Offset(1, 0), wks.Range("A1").End(xlToRight).Offset(1, 0).End(xlDown))
    
    Set originalSort = wks.Range(wks.Range("B2"), wks.Range("B2").End(xlDown)) ' sort by category
    
    rngToSort.Sort Key1:=keyRng, Order1:=xlDescending, Header:=xlNo
    
    'sort second, third, and any other subsequent sections
    
    Set nextSort = wks.Range("A1").End(xlDown).End(xlDown) 'assumes next section separated by at least one blank line
    
    While nextSort.row <> wks.Range("A" & wks.Rows.Count).row
    
        Set nextSort = wks.Range(nextSort, nextSort.End(xlToRight).End(xlDown))
        
        'create helper column from original sort
        Set helpSortCol = nextSort.End(xlToRight).Offset(, 1).Resize(nextSort.Rows.Count)
        helpSortCol.Cells(1, 1).Formula = "=MATCH(B" & helpSortCol.Cells(1, 1).row & "," & originalSort.Address & ",0)" 'sort by category
        helpSortCol.FillDown
        
        'now sort the section
        Set rngToSort = Union(nextSort, helpSortCol) 'use the helper (last column) to sort
        
        rngToSort.Sort Key1:=helpSortCol, Order1:=xlAscending, Header:=xlNo
        
        'cleanup helpercolumn
        helpSortCol.ClearContents
        
        'setup for next sort, until done
        Set nextSort = nextSort.End(xlDown).End(xlDown)
    Wend
    
    Application.Calculation = xCalc
    
End Sub

Open in new window

See attached.

Dave
testworksheetforsort-r6.xlsm

dkcoop03

ASKER

Perfect! I really appreciate your time on this. I really like your approach and I'm going to go back and change some of my other code based on this. I am not experienced with a lot of this syntax so I had to step through it at first but it's great. I have two questions: what does the .resize(nextsort.rows.count) do when you set helpsortcol? And, you set rngtosort using a Union function. I'm not familiar with this function -- what does it do? I'll be applying this code to my "real" data tomorrow.

ASKER CERTIFIED SOLUTION

dlmille

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

dkcoop03

ASKER

I've really learned a lot from your solution and your answers to my questions. Thanks again.