VBA help to count Daytime,Nighttime and Summary

T

tseklee

New Member
Joined
Nov 4, 2023
Messages
20
Office Version
  1. 2007
Platform
  1. Windows
Hello, i am using Mr Rosenkrantz's VBA code to calculate daytime, nighttime and the summary in an excel sheet. Here is the referenced link:
www.excelacademy.nl

TIME REGISTRATION | Calculate multiple time shift hours

You can use VBA for time registration. Building a procedure that calculates the number of hours a person worked is not difficult. How does it work?
www.excelacademy.nl

I have made some changes to the code to count as nighttime from 00:00 to 05:00 since i don't want it to count as nighttime from 00:00 to 06:00 and namely i changed all 0.25 to 0.2083333333333.
I am having trouble though to make the code to actually count from 21:00 till 05:00. Here is the code that Mr Rosenkrantz created without any changes.

VBA - Timesheet with Day and Night shift hours

VBA Code: 
'''
'''------------------------------------------------------------------------------------------------
''' Code written and tested by:
''' MR Rosenkrantz
''' Spreadsheet Solutions
''' http://www.spreadsheetsolutions.nl
''' mark@spreadsheetsolutions.nl
''' Current version: 1.00 - dd 26/02/2020
'''------------------------------------------------------------------------------------------------
'''
Option Explicit
Public Sub CALCULATE_TOTALS()
    'Variables for ThisWorkbook -------------------------------------------------------------------
    Dim strTS_APP As String      'ThisWorkbook as String
    Dim wbTS_APP As Workbook     'ThisWorkbook as Workbook
    'Variables on worksheet Data ------------------------------------------------------------------
    Dim wsDATA As Worksheet      'Worksheet Data as worksheet object
    Dim cRecDATA As Integer      'Current record on worksheet DATA
    Dim lRecDATA As Integer      'Last record on worksheet DATA
    
    'Reference to Workbook and Worksheets
    strTS_APP = ThisWorkbook.Name
    Set wbTS_APP = Workbooks(strTS_APP)
    Set wsDATA = wbTS_APP.Worksheets("Data")

'-- Totals ----------------------------------------------------------------------------------------
    With wsDATA
        'Determine the Last record on the worksheet
        lRecDATA = .Cells(1048576, 2).End(xlUp).Row

        'Loop through all records from the Data Table
        For cRecDATA = 10 To lRecDATA

                'Case 01 - Start before 00:00 and End before 06:00
                If .Cells(cRecDATA, 8) > .Cells(cRecDATA, 9) And _
                   .Cells(cRecDATA, 9) <= 0.25 Then
                    'Part 01 - Hours before 00:00
                    .Cells(cRecDATA, 11) = 1 - .Cells(cRecDATA, 8)
                    'Part 02 - Hours between 00:00 and 06:00
                    .Cells(cRecDATA, 12) = .Cells(cRecDATA, 9)
                End If

                'Case 02 - Start before 00:00 and End after 06:00
                If .Cells(cRecDATA, 8) > .Cells(cRecDATA, 9) And _
                   .Cells(cRecDATA, 9) > 0.25 Then
                    'Part 01 - Hours before 00:00
                    .Cells(cRecDATA, 11) = 1 - .Cells(cRecDATA, 8)
                    'Part 02 - Hours between 00:00 and 06:00 (Always 6)
                    .Cells(cRecDATA, 12) = 0.25
                    'Part 03 - Hours after 06:00
                    .Cells(cRecDATA, 11) = .Cells(cRecDATA, 11) + (.Cells(cRecDATA, 9) - 0.25)
                End If

                'Case 03 - Start between 00:00 and 06:00 and End before 06:00
                If .Cells(cRecDATA, 8) >= 0 And _
                   .Cells(cRecDATA, 8) < 0.25 And _
                   .Cells(cRecDATA, 9) <= 0.25 Then
                    'Part 01 - Hours between 00:00 and 06:00
                    .Cells(cRecDATA, 12) = .Cells(cRecDATA, 9) - .Cells(cRecDATA, 8)
                End If

                'Case 04 - Start between 00:00 and 06:00 and End after 06:00
                If .Cells(cRecDATA, 8) >= 0 And _
                   .Cells(cRecDATA, 8) < 0.25 And _
                   .Cells(cRecDATA, 9) > 0.25 Then
                    'Part 01 - Hours between 00:00 and 06:00
                    .Cells(cRecDATA, 12) = 0.25 - .Cells(cRecDATA, 8)
                    'Part 02 - Hours after 06:00
                    .Cells(cRecDATA, 11) = .Cells(cRecDATA, 9) - 0.25
                End If

                'Case 05 - Start after 06:00 and End after 06:00
                If .Cells(cRecDATA, 8) < .Cells(cRecDATA, 9) And _
                   .Cells(cRecDATA, 8) > 0.25 Then
                    'Part 01 - Hours after 06:00
                    .Cells(cRecDATA, 11) = .Cells(cRecDATA, 9) - .Cells(cRecDATA, 8)
                End If

                'Add to Grand Total
                .Cells(cRecDATA, 13) = .Cells(cRecDATA, 11) + .Cells(cRecDATA, 12) - .Cells(cRecDATA, 10)

        Next cRecDATA
    .Cells(6, 11).Select
    End With
End Sub

Can someone help please?
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Works for me.
Make sure you changed all 11 locations of 0.25
 
Upvote 0
NoSparks said:
Works for me.
Make sure you changed all 11 locations of 0.25
Click to expand...
I don't think i have made a mistake actually. The 0.25 corresponds to the time 06:00 and the number 0.2083333333333 to the time 05:00, what i need it to do though is to change also the starting count time from 00:00 to 21:00. I know that the number for 21:00 is 0.875 but when i change the number 1 which corresponds to the time 00:00 to 0.875 then it will show error.
 
Upvote 0
Any reason this needs to be code and not just a formula ?
Also please post at a bare minimum an image of your data that contain the row and column references. An XL2BB of the data would be even better.

20240810 VBA Time in Night shift tseklee.xlsm
ABCDEFGHIJ
1ItemStartEndDay TimeNight TimeTotalNightFromTo
2120:003:006:0021:005:00
3220:0023:592:59
431:006:004:00
541:003:002:00
6
Sheet1
Cell Formulas
RangeFormula
E2:E5E2=IF(B2>C2,1-MAX(B2,$I$2)+MIN(C2,$J$2), IF(C2>$I$2,C2-MAX(B2,$I$2), IF(B2<$J$2,MIN(C2,$J$2)-B2,0)))
 
Upvote 0
Sorry, misinterpreted the original post.

You can't change the 1 as it refers to midnight not the start of the night shift.
It just conveniently happens that the night shift starts at midnight in Mr Rosenkrantz's example
and he states
The possibility to start a shift before midnight and end a shift before or after 06:00, leads to a total of three calculations that may have to be made for each of the five situations mentioned
Click to expand...

You need to use 1 for midnight when calculating the time UNTIL midnight.
ie: 1 - 21:00 = 3:00
 
Upvote 0
Alex Blakenburg said:
Any reason this needs to be code and not just a formula ?
Click to expand...
No, just that i need to have separate columns for Daytime/Nighttime and the example fit my needs perfectly. Can you please edit your formula to not make use of columns I and J. In my sheet i can't spare two extra columns, it is really full.
 
Upvote 0
NoSparks said:
Sorry, misinterpreted the original post.

You can't change the 1 as it refers to midnight not the start of the night shift.
It just conveniently happens that the night shift starts at midnight in Mr Rosenkrantz's example
and he states


You need to use 1 for midnight when calculating the time UNTIL midnight.
ie: 1 - 21:00 = 3:00
Click to expand...
Do you know how to do this in VBA?
 
Upvote 0
tseklee said:
No, just that i need to have separate columns for Daytime/Nighttime and the example fit my needs perfectly. Can you please edit your formula to not make use of columns I and J. In my sheet i can't spare two extra columns, it is really full.
Click to expand...
If you didn't want it on that sheet I would put it on a parameters sheet rather than hard coding it into the formula.
If you really want to hard code it try this:

VBA Code: 
=IF(B2>C2,1-MAX(B2,21/24)+MIN(C2,5/24),
    IF(C2>21/24,C2-MAX(B2,21/24),
    IF(B2<5/24,MIN(C2,5/24)-B2,0)))
 
Upvote 0
Alex Blakenburg said:
If you didn't want it on that sheet I would put it on a parameters sheet rather than hard coding it into the formula.
If you really want to hard code it try this:

VBA Code: 
=IF(B2>C2,1-MAX(B2,21/24)+MIN(C2,5/24),
    IF(C2>21/24,C2-MAX(B2,21/24),
    IF(B2<5/24,MIN(C2,5/24)-B2,0)))
Click to expand...
The formula will return 5 if the cells are left empty.
 
Upvote 0
Here's a VBA macro you can try.
It's written to run against the sheet downloaded from the site you linked to.
Format the Day, Night, Total area as number with 2 decimal places to show hours as hours instead of times.
If required, can supply my test file.
VBA Code: 
Option Explicit


Sub Calc_Totals()

    Const DayStart As Double = #5:00:00 AM#
    Const NightStart As Double = #9:00:00 PM#
    
    Dim WorkStart As Double, WorkEnd As Double
    Dim DayHours As Double, NightHours As Double, BreakHours As Double
    
    Dim lastrow As Long
    Dim rng As Range, cel As Range
    
    With Sheets("DATA")
        lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row
        ' clear existing results
        .Range("K10:M" & lastrow).ClearContents
        
        ' set the range to work with
        Set rng = .Range("H10:H" & lastrow)
        
        For Each cel In rng
            WorkStart = cel
            WorkEnd = cel.Offset(, 1)
            BreakHours = cel.Offset(, 2)
            
            ' start within dayshift
            If WorkStart >= DayStart And WorkStart < NightStart Then
                    If WorkEnd > WorkStart And WorkEnd <= NightStart Then
                        DayHours = WorkEnd - WorkStart
                    ElseIf WorkEnd > NightStart And WorkEnd < 1 Then
                        DayHours = NightStart - WorkStart
                        NightHours = WorkEnd - NightStart
                    ElseIf WorkEnd <= DayStart Then
                        DayHours = NightStart - WorkStart
                        NightHours = 1 - NightStart + WorkEnd
                    ElseIf WorkEnd > DayStart And WorkEnd <= WorkStart Then
                        DayHours = NightStart - WorkStart + WorkEnd - DayStart
                        NightHours = 1 - NightStart + DayStart
                    End If
            End If
            
            'within nightshift before midnight
            If WorkStart >= NightStart And WorkStart < 1 Then
                    If WorkEnd > WorkStart And WorkEnd <= 1 Then
                        NightHours = WorkEnd - WorkStart
                    ElseIf WorkEnd <= DayStart Then
                        NightHours = 1 - WorkStart + WorkEnd
                    ElseIf WorkEnd > DayStart Then
                        DayHours = WorkEnd - DayStart
                        NightHours = 1 - WorkStart + DayStart
                    End If
            End If
            
            'within nightshift after midnight
            If WorkStart <= DayStart Then
                    If WorkEnd > WorkStart And WorkEnd <= DayStart Then
                        NightHours = WorkEnd - WorkStart
                    ElseIf WorkEnd > DayStart And WorkEnd <= NightStart Then
                        DayHours = WorkEnd - DayStart
                        NightHours = DayStart - WorkStart
                    ElseIf WorkEnd > NightStart And WorkEnd <= 1 Then
                        DayHours = NightStart - DayStart
                        NightHours = DayStart - WorkStart + 1 - WorkEnd
                    ElseIf WorkEnd <= WorkStart Then
                        DayHours = NightStart - DayStart
                        NightHours = DayStart - WorkStart + 1 - NightStart + WorkEnd
                    End If
            End If
            
            'write calcs to sheet
            If Not IsEmpty(cel) And Not IsEmpty(cel.Offset(, 1)) Then
                .Cells(cel.Row, "K") = DayHours * 24
                .Cells(cel.Row, "L") = NightHours * 24
                .Cells(cel.Row, "M") = (DayHours + NightHours - BreakHours) * 24
            End If
            
            'reset in prep for next row
            DayHours = 0
            NightHours = 0
            BreakHours = 0
            
        Next cel
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
TIME LIMITATIONS
Replies
1
Views
89
cooleomter
C
D
  • Question Question
Formula help needed for working with days and times.
Replies
0
Views
423
dshtesy
D
tezza
  • Solved
Autosum specific rows and columns
Replies
2
Views
274
tezza
tezza
M
  • Solved
sumifs using date and time values
Replies
9
Views
367
Asbestos_Jen
Asbestos_Jen
B
  • Solved
Need to add two sets of minutes with custom formatting and round
Replies
1
Views
540
bh24524
B

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

Share this page

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