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]

on another sheet where i store my data

In that sheet are the columns exactly the same as in the "Mr Rosenkrantz's file" ?