VBA to autosort

[High77]

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.

 

[kennypete]

If you change column L to (for L5): =IF(F5="Yes","1",IF(G5="Yes","2",IF(H5="Yes","3",IF(I5="Yes","4",IF(J5="Yes","5","6")))))&TEXT(M5,"YYYYMMDD") then you should be able to sort the filtered columns by column L ascending. E.g.:

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Name	#	Town	Body	Used	Redundant	Self E	Furlough	Unemployed	RDS	Green	Sort	Date
2	Ff	7	X	Y	N	Yes	No	No	No	No	No	120200411	11/04/2020
3	Ll	13	X	Y	N	Yes	No	No	No	No	No	120200411	11/04/2020
4	Hh	9	X	Y	N	No	Yes	No	No	No	No	220200405	5/04/2020
5	Ee	6	X	Y	N	No	Yes	No	No	No	No	220200413	13/04/2020
6	Dd	5	X	Y	N	No	Yes	No	No	No	No	220200425	25/04/2020
7	Jj	11	X	Y	N	No	No	Yes	No	No	No	320200331	31/03/2020
8	Ii	10	X	Y	N	No	No	Yes	No	No	No	320200403	3/04/2020
9	Kk	12	X	Y	N	No	No	No	Yes	No	No	420200413	13/04/2020
10	Aa	2	X	Y	N	No	No	No	No	Yes	No	520200401	1/04/2020
11	Cc	4	X	Y	N	No	No	No	No	Yes	No	520200420	20/04/2020
12	Gg	8	X	Y	N	No	No	No	No	No	Yes	620200402	2/04/2020
13	Bb	3	X	Y	N	No	No	No	No	No	Yes	620200405	5/04/2020
SortL

Cell Formulas
Range	Formula
L2:L13	L2	=IF(F2="Yes","1",IF(G2="Yes","2",IF(H2="Yes","3",IF(I2="Yes","4",IF(J2="Yes","5","6")))))&TEXT(M2,"YYYYMMDD")

 

[High77]

That's great thanks, you're a diamond.

Can I make it auto sort, so there is no interaction needed? If so, How would I do that?

How would I get people removed from the list if Column E was a Yes, eg they are being used on another job so don't get counted?

 

[kennypete]

I guess it depends on what you mean by "removed" - deleted?, hidden?, sorted to the bottom? other?

There would be some easy ways to make this auto-sort on any update, though it would be easiest if rows 3 onward were an Excel Table rather than 'raw'. Would you be okay with that as part of the solution?

Once the answers to those points are known a solution should be fairly easy I expect.

 

[High77]

By removed, I mean hidden or put to the very bottom of the sort.

I can't see having columns 3 onwards as a table being an issue. The contents of the cells are just direct lifts off another sheet, and will be hidden when I release it to my colleagues to use.

 

[kennypete]

If your Task1 Worksheet is modified to have the data in an Excel Table named tblTask1, as illustrated below:

...then the following code as a Worksheet_Change macro (i.e. right click your Task1 sheet and "View Code") should do what you're wanting, I think:

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")
        
        Dim rng As Range
        Set rng = lobTable.Range
    
        ' 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

        ' This is hardcoded to column 6 (i.e. "Redundant"), but could be changed to find that column
        ' Show only the "No" rows for "Redundant"
        rng.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).
        rng.AutoFilter Field:=13, Criteria1:="<>" & Cells(2, 2)
        
        ' 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.Sort
            .SortFields.Add2 Key:=rngKey, CustomOrder:=xlAscending
            .Header = xlYes
            .Apply
        End With
        
    End If
    
End Sub

 

[High77]

Hi,

That seems great. Thanks. It seems to have a problem at the end

.SortFields.Add2 Key:=rngKey, CustomOrder:=xlAscending

Run-time error '424' Object required.

Any ideas??

 

[kennypete]

.Add2 was added with Excel 2016. So if you have an earlier version it will error. Try changing it to .Add which is very similar.
(You should indicate what version you are using in your profile too btw)

 

[kennypete]

Oddly too, I have discovered that the Field:=13 line, excluding the entered date, will only work when passed a MM/DD/YYYY date, regardless of the date preference. That may be a non-issue for that if you use that date setup, but if you don't you may need to change that line to: rng.AutoFilter Field:=13, Criteria1:="<>" & Month(Cells(2, 2)) & "/" & Day(Cells(2, 2)) & "/" & Year(Cells(2, 2)) as that then seems to work (despite my setup being DD/MM/YYYY)

 

[High77]

Hi Kennypete,

Thank you for all the time that you've invested in helping me. Everything you have put is good and works, I really do appreciate it.

I just have one thing.

When I type in a new date to get everything to update, it takes a few seconds to work it all out (its a decent size spreadsheet, so that's ok), and returns the results desired (in a "selected array") for 5 seconds or so, then returns to the unsorted list. Is there any way to keep the sorted order?

(I've updated my Office versions, work is 2016, but I still needed to change it to .Add)

Thanks,