Dropdown to automatically select shift based on time of the day

dinkss

Board Regular
Joined
Aug 25, 2020
Messages
129
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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!
01.png


Thanks for help!
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
You'll need VBA to do this.

Open a copy of your workbook. Right click on the sheet tab with your dropdowns and select View Code. On the sheet that opens, paste this code:

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim part1 As String, part2 As String

    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
    
    part1 = IIf(Evaluate("WEEKDAY(TODAY(),2)") > 5, "WEEKEND - ", "")
    part2 = IIf(Evaluate("(MOD(NOW(),1)>8/24)*(MOD(NOW(),1)<20/24)"), "DAYS", "NIGHTS")
    
    Target.Offset(, 1) = part1 & part2
    
End Sub

Close the VBA editor. In column J, select something from a dropdown, and see if you get the result desired. This assumes Saturday and Sunday are weekend days, and your day shift is from 8 am to 8 pm. Those values are in red. We can adjust the values if this doesn't match your actual shift times.
 
Upvote 0
You'll need VBA to do this.

Open a copy of your workbook. Right click on the sheet tab with your dropdowns and select View Code. On the sheet that opens, paste this code:

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim part1 As String, part2 As String

    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
   
    part1 = IIf(Evaluate("WEEKDAY(TODAY(),2)") > 5, "WEEKEND - ", "")
    part2 = IIf(Evaluate("(MOD(NOW(),1)>8/24)*(MOD(NOW(),1)<20/24)"), "DAYS", "NIGHTS")
   
    Target.Offset(, 1) = part1 & part2
   
End Sub

Close the VBA editor. In column J, select something from a dropdown, and see if you get the result desired. This assumes Saturday and Sunday are weekend days, and your day shift is from 8 am to 8 pm. Those values are in red. We can adjust the values if this doesn't match your actual shift times.


Could you please set up a code to work, to give me the following results based on time of the day?

These are the shifts and times:
08:00:00 - 15:59:59Day Shift
16:00:00 - 23:59:59Evening Shift
00:00:00 - 07:59:59Night Shift
08:00:00 - 19:59:59Weekend-Days
20:00:00 - 07:59:59Weekend-Nights

I would really appreciate your support / great help!

Regards
 
Upvote 0
Could you please set up a code to work, to give me the following results based on time of the day?

These are the shifts and times:
08:00:00 - 15:59:59Day Shift
16:00:00 - 23:59:59Evening Shift
00:00:00 - 07:59:59Night Shift
08:00:00 - 19:59:59Weekend-Days
20:00:00 - 07:59:59Weekend-Nights

I would really appreciate your support / great help!

Regards

Your code works perfectly but could you please adjust it to the table with times and shifts I sent? It's really important for me.

And could you please give me explanation of the code if you can?

Thanks
 
Upvote 0
First of all, Have a little patience! :p I realize that this is important to you, and you may have deadlines, but keep in mind that everyone here, me included, is a volunteer who gives of their time and efforts with no pay. We all have other things, like eating, sleeping, and possibly a paying job which really has first dibs on my time. Most people here, me included again, will stick with a question until it's resolved or they decide it's beyond their skill set. But it could take some time.

That said, try this:

VBA Code:
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
    
    If dow >= 2 And dow <= 6 Then                   ' Is it from Monday to Friday?
        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
    Else                                            ' If not M-F, it must be a weekend
        Select Case hod                             ' Check the hour of day
            Case Is < 8: shift = "Weekend-Nights"   ' Before 8 am? Weekend-nights
            Case Is < 20: shift = "Weekend-Days"    ' Before 8 pm? Weekend-days
            Case Else: shift = "Weekend-Nights"     ' After 8 pm? Back to Weekend-nights
        End Select
    End If
    
    Target.Offset(, 1) = shift                      ' Put the result in the cell 1 column to the right
    
End Sub

This should do what you want. It's well commented so you can see what it's doing. Check the ranges to see if the shifts match up where they should. Some times like 2:00 am on a Monday morning could be a weekend night, or a night shift, depending on how you define it.

Let me know how it works for you.
 
Upvote 0
First of all, Have a little patience! :p I realize that this is important to you, and you may have deadlines, but keep in mind that everyone here, me included, is a volunteer who gives of their time and efforts with no pay. We all have other things, like eating, sleeping, and possibly a paying job which really has first dibs on my time. Most people here, me included again, will stick with a question until it's resolved or they decide it's beyond their skill set. But it could take some time.

That said, try this:

VBA Code:
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
   
    If dow >= 2 And dow <= 6 Then                   ' Is it from Monday to Friday?
        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
    Else                                            ' If not M-F, it must be a weekend
        Select Case hod                             ' Check the hour of day
            Case Is < 8: shift = "Weekend-Nights"   ' Before 8 am? Weekend-nights
            Case Is < 20: shift = "Weekend-Days"    ' Before 8 pm? Weekend-days
            Case Else: shift = "Weekend-Nights"     ' After 8 pm? Back to Weekend-nights
        End Select
    End If
   
    Target.Offset(, 1) = shift                      ' Put the result in the cell 1 column to the right
   
End Sub

This should do what you want. It's well commented so you can see what it's doing. Check the ranges to see if the shifts match up where they should. Some times like 2:00 am on a Monday morning could be a weekend night, or a night shift, depending on how you define it.

Let me know how it works for you.
I will try it tonight and I will check how all works. I know you have your priorities. Sorry for being so annoying! I really appreciate your help.

I will test it and get back to you!

Good man,
Thanks a lot!

I would love to learn all that!
 
Upvote 0
I have checked and the code seems to be working OK. Have to test it over weekend.

Would it be possible to add a code to original one to stop/block editing cells after the SHIFT is filled in? Just want to stop users from manipulating of original information which is automatically entered.
 
Upvote 0
Another thing that I would love to get it sorted - is it possible to get colour changed across the rows (eg from A2:M2, after selecting "COMPLETED" option from dropdown list? I would like to get all information to be greyed out whenever I choose option "COMPLETED".

Please let me know if something like this is possible to do.

Thanks ?
 
Upvote 0
Graying out the row is easy enough with Conditional Formatting. Just select the A:M columns, click Conditional Formatting > New Rule > Use a formula > and enter:

=$J1="COMPLETED"

and choose your gray fill color.

Preventing someone from editing the cells after the shift is filled in is trickier. You could protect the whole sheet, and when the shift is filled in, the Change event could lock the cells on that row. That's probably the simplest way. But keep in mind that any kind of protection on Excel is inherently weak. Anyone with even rudimentary skills and enough desire can figure out how to circumvent it.
 
Upvote 0
Thanks a lot for the reply! I will try it this evening and get back to you! I really appreciate your help!
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,947
Members
448,534
Latest member
benefuexx

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