Looping TOIL List

[ESC1989]

Hi there, I'm trying to create a table that keeps track of which members of my team have priority when it comes to getting Time off in Lieu (TOIL). I need a fairly simple table with several columns

Priority number eg. 1st, 2nd, 3rd, 4th, etc
Staff name
Date TOIL Last Given

When the staff members name is clicked (or a checkbox), it should move their row to the bottom of the list and update the date. The next staff member will be moved up the list so if they were '2nd', they will now be '1st'

Please could anyone help?

 

[HighAndWilder]

Hi there, I'm trying to create a table that keeps track of which members of my team have priority when it comes to getting Time off in Lieu (TOIL). I need a fairly simple table with several columns

Priority number eg. 1st, 2nd, 3rd, 4th, etc
Staff name
Date TOIL Last Given

When the staff members name is clicked (or a checkbox), it should move their row to the bottom of the list and update the date. The next staff member will be moved up the list so if they were '2nd', they will now be '1st'

Please could anyone help?

Set up a table as below named 'tblTOIL' in a new worksheet and copy the VBA code into the worksheet code module.

If you change the date for any person then the table will be sorted and the person who has waited the longest for TOIL wll rise to the top.

If dates are the same then the priority will be the same.

Version 4 Average.xlsm
	A	B	C	D
1	Priority	Name	Date
2	1st	Name 7	25/08/2024
3	2nd	Name 12	26/08/2024
4	3rd	Name 5	29/08/2024
5	4th	Name 6	30/08/2024
6	5th	Name 9	31/08/2024
7	6th	Name 2	01/09/2024
8	6th	Name 3	01/09/2024
9	7th	Name 1	20/09/2024
10	7th	Name 8	20/09/2024
11	8th	Name 11	28/09/2024
12	8th	Name 10	28/09/2024
13	9th	Name 4	29/09/2024
14
TOIL1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C2:C13	Cell Value	=MIN($C$2:$C$13)	text	NO

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim intPriority As Integer

  If Target.CountLarge > 1 Then
    Exit Sub
  End If

  If Target.Column = 3 Then
  
    If Not IsDate(Target.Value) Then
      MsgBox "Please enter a valid date.", vbOKOnly, "Warning!"
      Application.EnableEvents = False
      Target.Value = ""
      Application.EnableEvents = True
      Target.Select
      Exit Sub
    End If
   
    Call subSortData
    
  End If
   
  Application.EnableEvents = False
  intPriority = 1
  Cells(2, 1).Value = fncOrdinalIndicator(intPriority)
  For i = 3 To ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row
    If Cells(i - 1, 3).Value < Cells(i, 3) Then
      intPriority = intPriority + 1
    End If
    Cells(i, 1).Value = fncOrdinalIndicator(intPriority)
  Next i
  Application.EnableEvents = True
  
End Sub

Private Sub subSortData()
Dim loToil As ListObject
  
  Set loToil = ActiveSheet.ListObjects("tblTOIL")

  loToil.Sort.SortFields.Clear
  loToil.Sort.SortFields.Add2 Key:=Range("tblTOIL[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
  With loToil.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  
End Sub

Private Function fncOrdinalIndicator(ByVal Number As Long) As String
Dim strOrdinalIndicator As String

  Select Case True
    Case Number Mod 100 = 11, Number Mod 100 = 12, _
      Number Mod 100 = 13
      strOrdinalIndicator = "th"
    Case Number Mod 10 = 1
      strOrdinalIndicator = "st"
    Case Number Mod 10 = 2
      strOrdinalIndicator = "nd"
    Case Number Mod 10 = 3
      strOrdinalIndicator = "rd"
    Case Else
      strOrdinalIndicator = "th"
  End Select
 
  fncOrdinalIndicator = Number & strOrdinalIndicator
 
End Function

 

[Peter_SSs]

Another option

You could try this 'event' code. To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test by double-clicking a name in column B.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 2 And Target.Row > 1 And Len(Target.Value) > 1 Then
    Application.ScreenUpdating = False
    Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(Target.Value, Date)
    Target.Resize(, 2).Delete Shift:=xlUp
    Application.ScreenUpdating = True
  End If
End Sub

Here is my original data

ESC1989.xlsm
	A	B	C
1	Priority	Name	Last date
2	1st	Jen	22/02/2024
3	2nd	Tom	7/07/2024
4	3rd	Ann	29/07/2024
5	4th	Ken	15/08/2024
6	5th	Joe	23/09/2024
7	6th	Kim	28/09/2024
8	7th	Jan	12/11/2024
9	8th	Abe	27/11/2024
10	9th	Bev	21/01/2025
11	10th	Dom	11/02/2025
12
Sheet1

This is what I get after I double-clicked Ken

ESC1989.xlsm
	A	B	C
1	Priority	Name	Last date
2	1st	Jen	22/02/2024
3	2nd	Tom	7/07/2024
4	3rd	Ann	29/07/2024
5	4th	Joe	23/09/2024
6	5th	Kim	28/09/2024
7	6th	Jan	12/11/2024
8	7th	Abe	27/11/2024
9	8th	Bev	21/01/2025
10	9th	Dom	11/02/2025
11	10th	Ken	22/02/2025
12
Sheet1