VBA to autosort

H

High77

New Member
Joined
Jul 6, 2010
Messages
31
Office Version
  1. 365
  2. 2016
  3. 2010
  4. 2007
Platform
  1. Windows
Hi,

I have a sheet that covers whether staff have been furloughed etc from their primary employer. I have about 10 different tasks to complete daily (2 requiring 10 individuals) and 150 people to fairly allocate work to. I wish to create a sorted list, so that I know who is the priority to use (as income supplementation). As I won't be the only user, and others have less of an idea that I do, I want it to be automated rather than use Custom Sort, hence the idea of VBA. Unless you can suggest an automatic formula.

I have a "data" tab, and below is my "Sorted" tab, with all of the array contents supplied from the "data" tab. I wish to have it listed in a couple of ways, but as 1 long list.

If Redundant = yes then they appear at the top, then all of these ordered by Date (so oldest is at the very top, eg if you worked yesterday - you are at the bottom of that section of the list),
If Self Employed, then these by date as above,
If Furloughed, then by date,
If RDS, then by date,
If WDS/Green book at the bottom of the list, then by date,

If anyones date in M is the same as B2, then they are ignored (as they already have work for that date).

I have created a column to help arrange the order, Column L, so that 1 goes to the top and 6 is at the bottom (desired order as shown in F2:K2).

In the example below, the order would be:

Eee - first as Self employed,
Aaa - as Oldest RDS,
Ccc - as Newest RDS,
Bbb - as WDS/Green book.

1587889403991.png
 
Sort by date Sort by votes
Hi Kennypete,

Further to my reply, I've worked out that it's calculating 3 times, maybe due to other formulas on other tabs.

I can't see it doing much on the first sweep. On the 2nd its calculating the sort. During third time, its showing the sorted & highlighted/selected array, and as soon as it finishes it goes back to the unsorted list. I hope that makes sense.
 
Upvote 0
Sorry, I'm not sure what would cause it to undo the sort. I do think the order of actions is not quite ideal though, so would recommend (other than .Add, which matters little anyway since .Add and .Add2 are almost identical anyway), doing the sort first. Also the filters can be within the same With statement, so this may help, noting is seems to perform better on my small dataset, but who knows on a big table:
VBA Code: 
Private Sub Worksheet_Change(ByVal target As Range)
    
    ' Checks for any changes to the Worksheet limited to within
    ' the table named tblTask1 or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("tblTask1[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Dim lobTable As ListObject
        Set lobTable = ActiveSheet.ListObjects("tblTask1")
        
        ' Turn off any exising autofiltering on the table tblTask1
        If ActiveSheet.ListObjects("tblTask1").ShowAutoFilter Then
            ActiveSheet.ListObjects("tblTask1").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table tblTask1
        ActiveSheet.ListObjects("tblTask1").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Dim rngKey As Range
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
            
        Dim rng As Range
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 6 (i.e. "Redundant"), but could be changed to find that column
            ' Show only the "No" rows for "Redundant"
            .AutoFilter Field:=6, Criteria1:="No"
            ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
        
    End If
    
End Sub
 
Upvote 0
I'm getting there and its almost working right. I have several tasks all needing the same type of VBA sort. I've tried to copy and paste it and obviously its not liked it. So I've deleted and amended the bits its highlighted. However, when I use the table formula, it works well for just 1 table, but with several table, it keep sorting by No to task the 4th column, but then adds them back in when finished. It's definitely the coding that I've got wrong. Can you have a look and see what I've deleted when I should have kept it and changed it a little.

VBA Code: 
Private Sub Worksheet_Change(ByVal target As Range)
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named BodyRecovery or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("BodyRecovery[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Dim lobTable As ListObject
        Set lobTable = ActiveSheet.ListObjects("BodyRecovery")
      
        ' Turn off any exising autofiltering on the table BodyRecovery
        If ActiveSheet.ListObjects("BodyRecovery").ShowAutoFilter Then
            ActiveSheet.ListObjects("BodyRecovery").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table BodyRecovery
        ActiveSheet.ListObjects("BodyRecovery").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Dim rngKey As Range
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Dim rng As Range
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Body Recovery"), but could be changed to find that column
            ' Show only the "Yes" rows for "Body Recovery"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named LogisticsDriving or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("LogisticsDriving[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("LogisticsDriving")
      
        ' Turn off any exising autofiltering on the table LogisticsDriving
        If ActiveSheet.ListObjects("LogisticsDriving").ShowAutoFilter Then
            ActiveSheet.ListObjects("LogisticsDriving").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table LogisticsDriving
        ActiveSheet.ListObjects("LogisticsDriving").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Logistics Driving"), but could be changed to find that column
            ' Show only the "Yes" rows for "Logistics Driving"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named Outpatients or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("Outpatients[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("Outpatients")
      
        ' Turn off any exising autofiltering on the table LogisticsDriving
        If ActiveSheet.ListObjects("Outpatients").ShowAutoFilter Then
            ActiveSheet.ListObjects("Outpatients").Range.AutoFilter
        End If
      
      
        ' Turn on autofiltering on the table Outpatients
        ActiveSheet.ListObjects("Outpatients").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Out Patients"), but could be changed to find that column
            ' Show only the "Yes" rows for "Out Patients"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
  
' Checks for any changes to the Worksheet limited to within
    ' the table named LogisticsExternal or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("LogisticsExternal[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("LogisticsExternal")
      
        ' Turn off any exising autofiltering on the table LogisticsDriving
        If ActiveSheet.ListObjects("LogisticsExternal").ShowAutoFilter Then
            ActiveSheet.ListObjects("LogisticsExternal").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table LogisticsExternal
        ActiveSheet.ListObjects("LogisticsExternal").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Logistics External"), but could be changed to find that column
            ' Show only the "Yes" rows for "Logistics External"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  

    ' Checks for any changes to the Worksheet limited to within
    ' the table named GeneralSupport or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("GeneralSupport[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("GeneralSupport")
      
        ' Turn off any exising autofiltering on the table GeneralSupport
        If ActiveSheet.ListObjects("GeneralSupport").ShowAutoFilter Then
            ActiveSheet.ListObjects("GeneralSupport").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table GeneralSupport
        ActiveSheet.ListObjects("GeneralSupport").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "General Support External"), but could be changed to find that column
            ' Show only the "Yes" rows for "General Support External"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named CallHandling or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("CallHandling[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("CallHandling")
      
        ' Turn off any exising autofiltering on the table CallHandling
        If ActiveSheet.ListObjects("CallHandling").ShowAutoFilter Then
            ActiveSheet.ListObjects("CallHandling").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table CallHandling
        ActiveSheet.ListObjects("CallHandling").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Call Handling"), but could be changed to find that column
            ' Show only the "Yes" rows for "Call Handling"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named BlueLight or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("BlueLight[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("BlueLight")
      
        ' Turn off any exising autofiltering on the table BlueLight
        If ActiveSheet.ListObjects("BlueLight").ShowAutoFilter Then
            ActiveSheet.ListObjects("BlueLight").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table BlueLight
        ActiveSheet.ListObjects("BlueLight").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Blue Light Driving"), but could be changed to find that column
            ' Show only the "Yes" rows for "Blue Light Driving"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
  
    ' Checks for any changes to the Worksheet limited to within
    ' the table named Other or cell B2 (date entered) only. Changes to other cells will
    ' be ignored
    If Not (Application.Intersect(ActiveSheet.Range("Other[#all]"), target) Is Nothing) Or _
       Not (Application.Intersect(ActiveSheet.Range("B2"), target) Is Nothing) Then
        Set lobTable = ActiveSheet.ListObjects("Other")
      
        ' Turn off any exising autofiltering on the table Other
        If ActiveSheet.ListObjects("Other").ShowAutoFilter Then
            ActiveSheet.ListObjects("Other").Range.AutoFilter
        End If
        ' Turn on autofiltering on the table Other
        ActiveSheet.ListObjects("Other").Range.AutoFilter

        ' Sort by the "Sort" column, ascending, so that the desired
        ' order is displayed.
        Set rngKey = lobTable.ListColumns("Sort").Range
        lobTable.Sort.SortFields.Clear
        With lobTable
            With .Sort
                .SortFields.Add Key:=rngKey, CustomOrder:=xlAscending
                .Header = xlYes
                .Apply
            End With
        End With
          
        Set rng = lobTable.Range
        With rng
            ' This is hardcoded to column 4 (i.e. "Other"), but could be changed to find that column
            ' Show only the "Yes" rows for "Other"
            .AutoFilter Field:=4, Criteria1:="Yes" ' This is hardcoded to column 13 (i.e. "Date"), but could be changed to find that column
            ' Show only the rows *without* the date entered in cell B2 (because the person has
            ' work that day). Also force MM/DD/YYYY as that seems to be necessary for it to work.
            .AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2))
        End With
      
    End If
  
End Sub


Thanks.

Oh yeah, the sorting issue I had before was coz I had the names match/index, so it was sorting twice, I found it though.
 
Last edited by a moderator:
Upvote 0
I think you will need to re-post because the highlighting is not there. Also it's much easier to see what's going on if you use the <vba/> button on the post toolbar. A screenshot (anonymised) may help too to see what you're trying to do. Cheers
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Sorting Issue
Replies
7
Views
201
kvsrinivasamurthy
K
R
  • Solved
Cells in the same column showing different date format
Replies
5
Views
384
Peter_SSs
Peter_SSs
E
  • Solved
Custom Sorting VBA
Replies
3
Views
439
eli_m
E
M
  • Question Question
VBA Help: Automatically Update Chart Series for New Time Periods in Investing Spreadsheet
Replies
5
Views
399
myall_blues
myall_blues
A
  • Solved
VBA - button to sort by date in ascending and descending order
Replies
6
Views
2K
Peter_SSs
Peter_SSs

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