Need Macro/VBA code for a rotating list

[RCan29]

Good Morning all,

I have a request for a code.

I have a list of 46 employees (a2:a46) that I would like to "rotate". If an employee works overtime, I will then enter a date on their corresponding F column and I would like their entire row to move all the way down on the list. The person on top of the list should be the next person to work overtime. For employee 1, his info is from a2 to f2 (and so forth). I would like a code that if I enter a date on F2, the entire a2 to f2 row would drop down to row a46:f46; thereby shifting all other entries one row up. For a just in case scenario, if employee 10 happened to work OT and I enter a date on f10, I would like him to move down to the bottom of the list as well.

On a separate question, I tried to record the macro of me entering the date on F2, cutting and pasting a2:f6 to a47; cutting and pasting a3:f47 to a2. Everything worked well as the entries shifted "up". However, how do I modify the macros so I can enter ANY date?

selectedSheet.getRange("F2").setValue("11/14/2024");

 

[dreid1011]

You can try the IsDate function: IsDate function (Visual Basic for Applications)

 

[RCan29]

Hello, Here is a small sample of the file. The list actually contains 46 people. I would like for the person and info on A2-F2 to move to the bottom of the list when you enter a date on C2 (Date worked OT). The whole list would then move up by one row.

The date on C2 can be any date in the future.

Thank you!

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a date in column C and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = flase
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 3 Then Exit Sub
    If IsDate(Target) Then
        Rows(Target.Row).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
        Rows(Target.Row).Delete
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub