Creating a Multi-column sort that also adds a line between different items

K

kgeetings

New Member
Joined
Oct 13, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
So I've got a start on the code to sort a list of materials where I can enter the materials how I want (seen here) and then it will sort to the correct way as seen in the second picture.
BeforeSortExample.png


Where I've got the "Let the Magic Happen v2" button to automatically sort the list to the way I want it, but I want to then add a new line (that is also still formatted with the boxes and formulas) like this:
FinalExample.png


This is my current code, but I'm stuck on how to add a "blank" line in between the different materials/sizes:
VBA Code: 
Private Sub Let_The_Magic_Happen_v2_Click()
Application.ScreenUpdating = False
    ' Sorts the worksheet
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("J35:J" & Cells(Rows.Count, "J").END(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "HRT,LASER,DELRIN,HDPE,8#XLPE", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("L35:L" & Cells(Rows.Count, "J").END(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("M35:M" & Cells(Rows.Count, "J").END(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("N35:N" & Cells(Rows.Count, "J").END(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("O35:O" & Cells(Rows.Count, "J").END(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= xlSortNormal
    With ActiveWorkbook.Worksheets("Quote_and_Cut").Sort
        .SetRange Range("A35:W" & Cells(Rows.Count, "J").END(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

    ' Fixes the Cut List Subtotal SUM, because Excel tries to change it during sort (this part isn't really too relevant to this post, but wanted to include it just in case)
    Dim ThisPos As Range
        With Range("U1:U32000")
            Set ThisPos  = .Find(What:="CUT LIST SUBTOTAL", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not ThisPos  Is Nothing Then
                Cell_Add= Split(ThisPos.Address, "$")
                ThisRow = Cell_Add(1)
                ThisCol = Cell_Add(2)
                ActiveWorkbook.Worksheets("Quote_and_Cut").Range("W" & ThisCol).Value = "=SUM(W35:W" & (ThisCol - 1) & ")"
            Else
                msgboxresponse = MsgBox("CUT LIST SUBTOTAL not found")
            End If
        End With
Application.ScreenUpdating = True
End With
End Sub

I appreciate any help that you can provide, thanks!
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
I think I have found a good solution to my problem as seen by the code below:
VBA Code: 
Private Sub Let_The_Magic_Happen_v2_Click()
Application.ScreenUpdating = False
    ' Sorts the worksheet
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("J35:J" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "HRT,HRTRND,HRA,HRCNL,HRRND,HRFLT,HRSHT,CFRND,CFFLT,ALT,ALTRND,ALA,ALCNL,ALRND,ALFLT,SSRND,SSA,SSFLT,SSSHT,LASER,DELRIN,NYLON,HDPE,UMHW,8#XLPE,MISC", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("L35:L" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("M35:M" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("N35:N" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("O35:O" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Quote_and_Cut").Sort
        .SetRange Range("A35:W" & Cells(Rows.Count, "J").End(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
    With Range("J35").Select
        Dim counter As Integer
        counter = 35
        mtlname = "a"
        mtlname2 = "a"
    Do Until mtlname2 = ""
        mtlname = "a"
        mtlname2 = "a"
        'Scrolls through the list and inserts a line between different materials
            Do Until mtlname <> mtlname2
            If Not counter < 32000 Then GoTo shortEnd 'stops overflow error
            mtlname = Cells(counter, 10)
            counter = counter + 1
            mtlname2 = Cells(counter, 10)
            Loop
    With Sheets("Quote_and_Cut")
    .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
    Selection.Insert shift:=xlDown
    counter = counter + 1
    End With
Loop
shortEnd:
    ' Fixes the Cut List Subtotal SUM, because Excel tries to change it during sort
    Dim ThisPos As Range
        With Range("U1:U32000")
            Set ThisPos = .Find(What:="CUT LIST SUBTOTAL", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not ThisPos Is Nothing Then
                Cell_Add = Split(ThisPos.Address, "$")
                ThisRow = Cell_Add(1)
                ThisCol = Cell_Add(2)
                ActiveWorkbook.Worksheets("Quote_and_Cut").Range("W" & ThisCol).Value = "=SUM(W35:W" & (ThisCol - 1) & ")"
            Else
                msgboxresponse = MsgBox("CUT LIST SUBTOTAL not found")
            End If
        End With
Application.ScreenUpdating = True
End With
End Sub
 
Upvote 0
kgeetings said:
I think I have found a good solution to my problem as seen by the code below:
VBA Code: 
Private Sub Let_The_Magic_Happen_v2_Click()
Application.ScreenUpdating = False
    ' Sorts the worksheet
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("J35:J" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "HRT,HRTRND,HRA,HRCNL,HRRND,HRFLT,HRSHT,CFRND,CFFLT,ALT,ALTRND,ALA,ALCNL,ALRND,ALFLT,SSRND,SSA,SSFLT,SSSHT,LASER,DELRIN,NYLON,HDPE,UMHW,8#XLPE,MISC", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("L35:L" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("M35:M" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("N35:N" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("O35:O" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Quote_and_Cut").Sort
        .SetRange Range("A35:W" & Cells(Rows.Count, "J").End(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
    With Range("J35").Select
        Dim counter As Integer
        counter = 35
        mtlname = "a"
        mtlname2 = "a"
    Do Until mtlname2 = ""
        mtlname = "a"
        mtlname2 = "a"
        'Scrolls through the list and inserts a line between different materials
            Do Until mtlname <> mtlname2
            If Not counter < 32000 Then GoTo shortEnd 'stops overflow error
            mtlname = Cells(counter, 10)
            counter = counter + 1
            mtlname2 = Cells(counter, 10)
            Loop
    With Sheets("Quote_and_Cut")
    .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
    Selection.Insert shift:=xlDown
    counter = counter + 1
    End With
Loop
shortEnd:
    ' Fixes the Cut List Subtotal SUM, because Excel tries to change it during sort
    Dim ThisPos As Range
        With Range("U1:U32000")
            Set ThisPos = .Find(What:="CUT LIST SUBTOTAL", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not ThisPos Is Nothing Then
                Cell_Add = Split(ThisPos.Address, "$")
                ThisRow = Cell_Add(1)
                ThisCol = Cell_Add(2)
                ActiveWorkbook.Worksheets("Quote_and_Cut").Range("W" & ThisCol).Value = "=SUM(W35:W" & (ThisCol - 1) & ")"
            Else
                msgboxresponse = MsgBox("CUT LIST SUBTOTAL not found")
            End If
        End With
Application.ScreenUpdating = True
End With
End Sub
Click to expand...
I've modified the code just a little for anyone wondering.
VBA Code: 
Private Sub Let_The_Magic_Happen_v2_Click()
Application.ScreenUpdating = False
    ' Sorts the worksheet
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("J35:J" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "HRT,HRTRND,HRA,HRCNL,HRRND,HRFLT,HRSHT,CFRND,CFFLT,ALT,ALTRND,ALA,ALCNL,ALRND,ALFLT,SSRND,SSA,SSFLT,SSSHT,LASER,DELRIN,NYLON,HDPE,UMHW,8#XLPE,MISC", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("L35:L" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("M35:M" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("N35:N" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Quote_and_Cut").Sort.SortFields.Add2 Key:=Range("O35:O" & Cells(Rows.Count, "J").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Quote_and_Cut").Sort
        .SetRange Range("A35:W" & Cells(Rows.Count, "J").End(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
'Removes the extra rows at the end of the cut sheet, as they are not needed.
With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
        Lastrow1 = .Cells(.Cells.Count).Row
End With
Dim EndOfCut As Range
    With Range("U1:U32000")
        Set EndOfCut = .Find(What:="CUT LIST SUBTOTAL", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not EndOfCut Is Nothing Then
            Cell_Add = Split(EndOfCut.Address, "$")
            ThisRow = Cell_Add(1)
            ThisCol = Cell_Add(2)
            If (Lastrow1 + 1) <> ThisCol Then
                Rows((Lastrow1 + 1) & ":" & (ThisCol - 1)).EntireRow.Delete
            End If
        Else
            msgboxresponse = MsgBox("CUT LIST SUBTOTAL not found")
        End If
    End With
'Removes all the rows below the last data in W because like why are they there.
'Dim bottomrow, lastblank as long
'    Bottomrow = ActiveSheet.UsedRange.Rows.Count
'    lastblank = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'    Range("W" & Lastblank & "W" & Bottomrow).EntireRow.Delete
'Scrolls through the list and inserts a line between different materials
    With Range("J35").Select
        Dim counter As Integer
        counter = 35
        mtlname = "a"
        mtlname2 = "a"
        Dim EndCount As Integer
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
    Do While counter < EndCount
        softEnd0:
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
        mtlname = "a"
        mtlname2 = "a"
        Do While (mtlname = mtlname2)
            If counter >= EndCount Then 
                GoTo hardEnd0
            Else
                mtlname = Cells(counter, 10)
                counter = counter + 1
                mtlname2 = Cells(counter, 10)
            End If
        Loop
        With Sheets("Quote_and_Cut")
            If mtlname2 = "" Then
                counter = counter + 1
                GoTo softEnd0
            Else
                .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
                Selection.Insert shift:=xlDown
                counter = counter + 1
            End If
        End With
    hardEnd0:
    Loop

'Scrolls through the list and inserts a line between different DIM1
    With Range("L35").Select
        counter = 35
        dim1name = "0"
        dim1name2 = "0"
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
    Do While counter < EndCount
        softEnd1:
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
        dim1name = "0"
        dim1name2 = "0"
        Do While (dim1name = dim1name2)
            If counter >= EndCount Then 
                GoTo hardEnd1
            Else
                dim1name = Cells(counter, 12)
                counter = counter + 1
                dim1name2 = Cells(counter, 12)
            End If
        Loop
        With Sheets("Quote_and_Cut")
            If Cells(counter, 10) = "" Or Cells(counter -1, 10) = "" Then
                counter = counter + 1
                GoTo softEnd1
            Else
                .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
                Selection.Insert shift:=xlDown
                counter = counter + 1
            End If
        End With
    Loop
    hardEnd1:  
    End With
'Scrolls through the list and inserts a line between different DIM2
    With Range("M35").Select
        counter = 35
        dim2name = "0"
        dim2name2 = "0"
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
    Do While counter < EndCount
        softEnd2:
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
        dim2name = "0"
        dim2name2 = "0"
        Do While (dim2name = dim2name2)
            If counter >= EndCount Then 
                GoTo hardEnd2
            Else
                dim2name = Cells(counter, 13)
                counter = counter + 1
                dim2name2 = Cells(counter, 13)
            End If
        Loop
        With Sheets("Quote_and_Cut")
            If Cells(counter, 10) = "" Or Cells(counter -1, 10) = "" Then
                counter = counter + 1
                GoTo softEnd2
            Else
                .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
                Selection.Insert shift:=xlDown
                counter = counter + 1
            End If
        End With
    Loop
    hardEnd2:  
    End With
'Scrolls through the list and inserts a line between different DIM3
    With Range("N35").Select
        counter = 35
        dim3name = "0"
        dim3name2 = "0"
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
    Do While counter < EndCount
        softEnd3:
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
        dim3name = "0"
        dim3name2 = "0"
        Do While (dim3name = dim3name2)
            If counter >= EndCount Then 
                GoTo hardEnd3
            Else
                dim2name = Cells(counter, 14)
                counter = counter + 1
                dim2name2 = Cells(counter, 14)
            End If
        Loop
        With Sheets("Quote_and_Cut")
            If Cells(counter, 10) = "" Or Cells(counter -1, 10) = "" Then
                counter = counter + 1
                GoTo softEnd3
            Else
                .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
                Selection.Insert shift:=xlDown
                counter = counter + 1
            End If
        End With
    Loop
    hardEnd3:  
    End With
    ' Fixes the Cut List Subtotal SUM, because Excel tries to change it during sort
    Dim ThisPos As Range
        With Range("U1:U32000")
            Set ThisPos = .Find(What:="CUT LIST SUBTOTAL", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not ThisPos Is Nothing Then
                Cell_Add = Split(ThisPos.Address, "$")
                ThisRow = Cell_Add(1)
                ThisCol = Cell_Add(2)
                ActiveWorkbook.Worksheets("Quote_and_Cut").Range("W" & ThisCol).Value = "=SUM(W35:W" & (ThisCol - 1) & ")"
            Else
                msgboxresponse = MsgBox("CUT LIST SUBTOTAL not found")
            End If
        End With
Application.ScreenUpdating = True
End With
End Sub
 
Upvote 0
Thank you for providing an update and posting your solution & subsequent update. I did notice that is not putting in a blank line at each unique combination of "Material Type", "Dim 1", "Dim 2", "Dim 3", "Length" but if it enough for what you want then I will leave it there.
 
Upvote 0
Alex Blakenburg said:
Thank you for providing an update and posting your solution & subsequent update. I did notice that is not putting in a blank line at each unique combination of "Material Type", "Dim 1", "Dim 2", "Dim 3", "Length" but if it enough for what you want then I will leave it there.
Click to expand...
Alex, maybe I’m misunderstanding what you’re saying, but my solution is adding a blank line at each unique combination of “Material Type”, “Dim1”,”Dim2”, and “Dim3” but I never wanted it to add a blank line for different “Length” values. If that’s what you’re asking? If not, let me know.
 
Upvote 0
Good to know. When I tried your latest version it did not put a blank line on a Dim3 change.
 
Upvote 0
Oh wow, thanks for mentioning that. You're right, mine doesn't seem to be adding a blank line on a Dim3 change either. If you have an idea on why, or some code to fix that issue, I would greatly appreciate it. Otherwise, I'll work on it again later tomorrow.
 
Upvote 0
Actually, looks like it just forgot to change my values when I copied and pasted from Dim2. The correct Dim3 should be this:
VBA Code: 
'Scrolls through the list and inserts a line between different DIM3
    With Range("N35").Select
        counter = 35
        dim3name = "0"
        dim3name2 = "0"
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
    Do While counter < EndCount
        softEnd3:
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With
        dim3name = "0"
        dim3name2 = "0"
        Do While (dim3name = dim3name2)
            If counter >= EndCount Then 
                GoTo hardEnd3
            Else
                dim3name = Cells(counter, 14)
                counter = counter + 1
                dim3name2 = Cells(counter, 14)
            End If
        Loop
        With Sheets("Quote_and_Cut")
            If Cells(counter, 10) = "" Or Cells(counter -1, 10) = "" Then
                counter = counter + 1
                GoTo softEnd3
            Else
                .Range(.Cells(counter, 1), .Cells(counter, 23)).Select
                Selection.Insert shift:=xlDown
                counter = counter + 1
            End If
        End With
    Loop
    hardEnd3:  
    End With

Although when messing with this a little more, I did also realize that it doesn't split the very last material (like the last line of the cut list) with the one before it even if it's different.
 
Upvote 0
OK a couple of changes.
The overflow error you are trapping shouldn't happen if you change these 2 that are currently integer.
VBA Code: 
Dim counter as long, EndCount as long

This currently used line used in a number of places doesn't work. All it needs to do is to work out the last row.
It is counting constant values which means eventhough the code is redoing it after inserting each blank row, blank rows are not being counted so the number is not increasing after every insert.
Currently
VBA Code: 
        With Worksheets("Quote_and_Cut").Columns("J").SpecialCells(xlCellTypeConstants)
            EndCount = .Cells(.Cells.Count).Row
        End With

You wold be better off with this.
You can either keep checking this on just go EndCount = EndCount + 1
every time you insert a row.
VBA Code: 
EndCount = Worksheets("Quote_and_Cut").Cells(Rows.Count, "J").End(xlUp).Row


1634275728939.png
 
Last edited:
Upvote 0
Also see how your final code performs on your real data. If it performs ok then we can leave it there. If it is really slow, then you can try my version.
To use my version you would have to be happy to:-
a) use a helper sheet - output of a Unique value combintion Advanced filter - this can be hidden
b) an additional sort on the ID field (you are not using it in the sort now and it would mean lines that have everything else the same would be in ID order)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA - button to sort by date in ascending and descending order
Replies
6
Views
471
Peter_SSs
Peter_SSs
Dazzawm
  • Solved
Slight Amendment To Code
Replies
6
Views
312
Dazzawm
Dazzawm
SandsB
  • Question
Sorting when a column or 2 is empty
Replies
1
Views
181
DanteAmor
DanteAmor
H
  • Solved
Column sort
Replies
9
Views
171
Fluff
Fluff
O
  • Solved
VBA: Deleting Visible rows using Auto Filter; Excluding Header
Replies
4
Views
463
mumps
mumps

Forum statistics

Threads
1,215,759
Messages
6,126,732
Members
449,333
Latest member
Adiadidas

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top