VBA help to count Daytime,Nighttime and Summary

[tseklee]

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:

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

'''
'''------------------------------------------------------------------------------------------------
''' 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?

 

[Alex Blakenburg]

The formula will return 5 if the cells are left empty.

How about:

=IF(AND(B2<>"",C2<>""),
    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))),"")

 

[tseklee]

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.

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

I can't get the correct results. Please check the picture.

 

[tseklee]

How about:

=IF(AND(B2<>"",C2<>""),
    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))),"")

No. These are the results i am getting now.

 

[Alex Blakenburg]

Show us what you are expecting ? What are you showing is consistent with my understanding of what you have described as being the requirement.
PS: If you are going to use pictures please make sure you include the Row and Column references (and for VBA the sheet name as well)

 

[tseklee]

Show us what you are expecting ? What are you showing is consistent with my understanding of what you have described as being the requirement.
PS: If you are going to use pictures please make sure you include the Row and Column references (and for VBA the sheet name as well)

Ok, i have just typed them right next to the results i am getting.
So, i want it to count as nighttime from 21:00 to 05:00. The other columns are pretty much self explanatory.
This is also the same columns and lanes using Mr Rosenkrantz's file, exactly as you written it to be used.

 

[NoSparks]

I can't get the correct results. Please check the picture.

just go into the code and remove the * 24 from each of the 3 lines near the end to be like this

            'write calcs to sheet
            If Not IsEmpty(cel) And Not IsEmpty(cel.Offset(, 1)) Then
                .Cells(cel.Row, "K") = DayHours
                .Cells(cel.Row, "L") = NightHours
                .Cells(cel.Row, "M") = (DayHours + NightHours - BreakHours)
            End If

 

[Alex Blakenburg]

Let me know if you are just not interested in using a formula, although in your scenario I am not sure why you would want VBA.
Based on your last example that is exactly what the formula I gave you produces, so I am not sure why you said it is not working.

20240810 VBA Time in Night shift tseklee.xlsm
	A	B	C	D	E	F
1	Item	Start	End	Day Time	Night	Total
2	1	23:59	5:59	0:59	5:01	6:00
3	2	23:59	6:01	1:01	5:01	6:02
4	3	0:01	5:59	0:59	4:59	5:58
5	4	0:01	6:01	1:01	4:59	6:00
6		6:01	12:01	6:00	0:00	6:00
7		6:00	0:00	15:00	3:00	18:00
Sheet1 Diff Example

Cell Formulas
Range	Formula
D2:D7	D2	=F2-E2
E2:E7	E2	=IF(AND(B2<>"",C2<>""), 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))),"")
F2:F7	F2	=IF(C2<B2,C2+1-B2,C2-B2)

 

[tseklee]

just go into the code and remove the * 24 from each of the 3 lines near the end to be like this

            'write calcs to sheet
            If Not IsEmpty(cel) And Not IsEmpty(cel.Offset(, 1)) Then
                .Cells(cel.Row, "K") = DayHours
                .Cells(cel.Row, "L") = NightHours
                .Cells(cel.Row, "M") = (DayHours + NightHours - BreakHours)
            End If

Thank you now it seems to be working fine.

 

[tseklee]

Let me know if you are just not interested in using a formula, although in your scenario I am not sure why you would want VBA.
Based on your last example that is exactly what the formula I gave you produces, so I am not sure why you said it is not working.

20240810 VBA Time in Night shift tseklee.xlsm
	A	B	C	D	E	F
1	Item	Start	End	Day Time	Night	Total
2	1	23:59	5:59	0:59	5:01	6:00
3	2	23:59	6:01	1:01	5:01	6:02
4	3	0:01	5:59	0:59	4:59	5:58
5	4	0:01	6:01	1:01	4:59	6:00
6		6:01	12:01	6:00	0:00	6:00
7		6:00	0:00	15:00	3:00	18:00
Sheet1 Diff Example

Cell Formulas
Range	Formula
D2:D7	D2	=F2-E2
E2:E7	E2	=IF(AND(B2<>"",C2<>""), 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))),"")
F2:F7	F2	=IF(C2<B2,C2+1-B2,C2-B2)

I don't know the difference between using a VBA script and a formula. Yes, i am so newbie. For the moment though i am really happy to give both ways some testing.
Can you please edit the Total/Summary column(F) so that it takes into account also the break? Also for some reason i am getting false results.
Also the Daytime column can it output 0 or be blank instead of returning "Value" when no entry is found?

 

[tseklee]

Let me know if you are just not interested in using a formula, although in your scenario I am not sure why you would want VBA.
Based on your last example that is exactly what the formula I gave you produces, so I am not sure why you said it is not working.

20240810 VBA Time in Night shift tseklee.xlsm
	A	B	C	D	E	F
1	Item	Start	End	Day Time	Night	Total
2	1	23:59	5:59	0:59	5:01	6:00
3	2	23:59	6:01	1:01	5:01	6:02
4	3	0:01	5:59	0:59	4:59	5:58
5	4	0:01	6:01	1:01	4:59	6:00
6		6:01	12:01	6:00	0:00	6:00
7		6:00	0:00	15:00	3:00	18:00
Sheet1 Diff Example

Cell Formulas
Range	Formula
D2:D7	D2	=F2-E2
E2:E7	E2	=IF(AND(B2<>"",C2<>""), 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))),"")
F2:F7	F2	=IF(C2<B2,C2+1-B2,C2-B2)

I am sorry, i have tested again your formula on a new sheet and it seems to return correct nighttime results. But on another sheet where i store my data the results are wrong, exactly like the picture i posted. Now i'm puzzled...