Dropdown to automatically select shift based on time of the day

[dinkss]

Hi there,

I'm new to VBA and Excel. I'm trying to write formula or VBA code to be able to get EXCEL to automatically enter WORK SHIFT based on time when data was selected from dropdown list.
I have created dropdown list but now I want EXCEL to enter WORK SHIFT automatically when I select any options from dropdown list no matter what time it will be. I want excel to know if I select data at 10:00:00 that this is Day Shift and if I select Data at 19:00:00 that this is Evening Shift.

My dropdown menu is in Cells J:J and I want excel to automatically enter work shift in K:K based on time when I select information from my dropdown list.

I have attached screenshot of my worksheet.

Please help me, it is really important for me!

Thanks for help!

 

[dinkss]

Thanks a lot for the reply! I will try it this evening and get back to you! I really appreciate your help!

Eric, I just spotted a wee glitch if I can call it that way. Your code for shifts works perfectly. But I'm on nights now, and it displays weekend nights instead of night shift.

Can this be adjusted or changed?
These are the shifts:
Day shift - Monday to Friday from 8 am til 4pm
Evening shift - Monday to Friday from 4pm til 12am
Night shift - Monday to Friday from 12am til 8am, but on Friday night shift finishes at 5am on Saturday.

And weekend days starting from Saturday 5am till Saturday 8pm. Weekend nights from 8pm til 8am. Weekend days Sunday 8am til 8pm and weekend nights 8pm til 8am.

Can night shift be adjusted to last until Saturday morning til 5am?

 

[Eric W]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dow As Long, hod As Long, shift As String

    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub     ' Is the target cell in the J column?
    If Target.Cells.Count > 1 Then Exit Sub                         ' Does the selected range have only 1 cell?
  
    dow = Evaluate("WEEKDAY(TODAY())")              ' Get the day of week using the worksheet function
    hod = Evaluate("HOUR(NOW())")                   ' Get the hour of day using the worksheet function
  
    Select Case dow
        Case 1                                      ' Sunday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 20: shift = "Weekend-days"    ' hours 8 am to 8 pm
                Case Else: shift = "Weekend-nights"     ' hours after 8 pm
            End Select
        Case 2                                      ' Monday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 16: shift = "Day Shift"       ' hours 8am to 8 pm
                Case Else: shift = "Evening Shift"      ' hours after 8 pm
            End Select
        Case 3 To 6                                 ' Tues-Fri
            Select Case hod                             ' Check the hour of day
                Case Is < 8: shift = "Night Shift"      ' Hour is before 8 am, it's night shift
                Case Is < 16: shift = "Day Shift"       ' Hour is before 4 pm, it's day shift
                Case Else: shift = "Evening Shift"      ' After 4 pm, it's evening shift
            End Select
        Case 7                                      'Saturday
            Select Case hod
                Case Is < 5: shift = "Night Shift"      ' hours 0-5
                Case Is < 20: shift = "Weekend-days"    ' hours 5 - 8 pm
                Case Else: shift = "Weekend-nights"     ' after 8 pm
            End Select
    End Select
  
    Target.Offset(, 1) = shift                      ' Put the result in the cell 1 column to the right
  
End Sub

I'm still not entirely sure I have the ranges right, but it should be easy enough to see how to adjust them.

 

[dinkss]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dow As Long, hod As Long, shift As String

    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub     ' Is the target cell in the J column?
    If Target.Cells.Count > 1 Then Exit Sub                         ' Does the selected range have only 1 cell?
 
    dow = Evaluate("WEEKDAY(TODAY())")              ' Get the day of week using the worksheet function
    hod = Evaluate("HOUR(NOW())")                   ' Get the hour of day using the worksheet function
 
    Select Case dow
        Case 1                                      ' Sunday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 20: shift = "Weekend-days"    ' hours 8 am to 8 pm
                Case Else: shift = "Weekend-nights"     ' hours after 8 pm
            End Select
        Case 2                                      ' Monday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 16: shift = "Day Shift"       ' hours 8am to 8 pm
                Case Else: shift = "Evening Shift"      ' hours after 8 pm
            End Select
        Case 3 To 6                                 ' Tues-Fri
            Select Case hod                             ' Check the hour of day
                Case Is < 8: shift = "Night Shift"      ' Hour is before 8 am, it's night shift
                Case Is < 16: shift = "Day Shift"       ' Hour is before 4 pm, it's day shift
                Case Else: shift = "Evening Shift"      ' After 4 pm, it's evening shift
            End Select
        Case 7                                      'Saturday
            Select Case hod
                Case Is < 5: shift = "Night Shift"      ' hours 0-5
                Case Is < 20: shift = "Weekend-days"    ' hours 5 - 8 pm
                Case Else: shift = "Weekend-nights"     ' after 8 pm
            End Select
    End Select
 
    Target.Offset(, 1) = shift                      ' Put the result in the cell 1 column to the right
 
End Sub

I'm still not entirely sure I have the ranges right, but it should be easy enough to see how to adjust them.

Good man, thank you so much for your help! I will test it tomorrow and will get back to you!

 

[dinkss]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dow As Long, hod As Long, shift As String

    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub     ' Is the target cell in the J column?
    If Target.Cells.Count > 1 Then Exit Sub                         ' Does the selected range have only 1 cell?

    dow = Evaluate("WEEKDAY(TODAY())")              ' Get the day of week using the worksheet function
    hod = Evaluate("HOUR(NOW())")                   ' Get the hour of day using the worksheet function

    Select Case dow
        Case 1                                      ' Sunday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 20: shift = "Weekend-days"    ' hours 8 am to 8 pm
                Case Else: shift = "Weekend-nights"     ' hours after 8 pm
            End Select
        Case 2                                      ' Monday?
            Select Case hod
                Case Is < 8: shift = "Weekend-nights"   ' hours 0-8
                Case Is < 16: shift = "Day Shift"       ' hours 8am to 8 pm
                Case Else: shift = "Evening Shift"      ' hours after 8 pm
            End Select
        Case 3 To 6                                 ' Tues-Fri
            Select Case hod                             ' Check the hour of day
                Case Is < 8: shift = "Night Shift"      ' Hour is before 8 am, it's night shift
                Case Is < 16: shift = "Day Shift"       ' Hour is before 4 pm, it's day shift
                Case Else: shift = "Evening Shift"      ' After 4 pm, it's evening shift
            End Select
        Case 7                                      'Saturday
            Select Case hod
                Case Is < 5: shift = "Night Shift"      ' hours 0-5
                Case Is < 20: shift = "Weekend-days"    ' hours 5 - 8 pm
                Case Else: shift = "Weekend-nights"     ' after 8 pm
            End Select
    End Select

    Target.Offset(, 1) = shift                      ' Put the result in the cell 1 column to the right

End Sub

I'm still not entirely sure I have the ranges right, but it should be easy enough to see how to adjust them.

Hi Eric,

Your code works perfectly! Thanks very much for your help!

Can I send you a excel file with all vba coding and would you be able to have a look at it with your professional eye, tell me what's good or what's bad and how to correct it properly or maybe you could correct it on the go?

Also how can I create a VBA CODE to run a COUNTDOWN TIMER - a pop-up message, 30 seconds before Macro will run? I want to have a pop-up message which states: "This schedule will AUTO-UPDATE & AUTO-SAVE in 30 seconds. Do not edit it now. " before macro will run.

I will appreciate any help .

 

[Eric W]

I'm glad it works for you!

As far as sending a workbook, it's against the rules here to send files to individuals. The idea is that everything should be in the public forum so that everyone can learn from it. You could post your code, or portions of it, in a new thread and see if anyone will make recommendations. That's been done before, and you'll probably get some ideas from it.


The countdown timer is surprisingly difficult. I assume you'll kick off the countdown timer macro with the OnTime event, but then the problem is that macro code doesn't execute if the sheet is in edit mode. So if someone tries to edit a cell while the timer is running, then the timer will be paused. A very bright contributor here has come up with a couple of options that might work for you though. Check out these links:

Excel Protected sheet with Timer trigger

Hi, I created excel sheet with timer trigger, so the sheet will protected after timer reach 00:00. The timer is work and excel is protected after timer reach 00:00 but my issue if i put cursor in edit mode, the timer stop moved and my excel become protected before it reach 0 (since actual timer...

www.mrexcel.com

Timed InputBox

Hi all, I have seen this requested on some occasions and the usual answer is to create a userform that looks and behaves like an inputbox and then use OnTime to schedule the closing of the userform upon time-out. In case anyone is interested, I am showing here an alternative that uses the...

www.mrexcel.com

I can't really help with these, since I didn't write them, but you should be able to figure it out. Good luck!