We purchased a time clock, and the time clock company supplied us with a macro that total the daily hours as well as the total hours for any date range that we choose. Our company policy is if an employee works 6.5 or more hours per day, we subtract .5 hours from that days hours for lunch. I would like to edit the code to perform this action while calculating the hours.
HERE IS A COPY OF THE TIME CLOCK PUNCH REPORT THAT GENERATES FroM OUR TIME CLOCK
<tbody>
</tbody>
HERE IS THE VBA CODE TO CALCULATE THE HOURS
HERE IS A COPY OF THE TIME CLOCK PUNCH REPORT THAT GENERATES FroM OUR TIME CLOCK
| Time Card Report | |||||||||||||
| 10/1/2015 - 10/30/2015 | |||||||||||||
| Downloaded: | 10/27/2015 02:34 PM | ||||||||||||
| No: 496386 | Name: NAME | Dept: | Shift: NULL | Daily totals | |||||||||
| Date | Week | (IN) | (OUT) | (IN) | (OUT) | (IN) | (OUT) | (IN) | (OUT) | Regular Hours | OT Hours | Other Hours | Notes |
| 10/01 | THU | ||||||||||||
| 10/02 | FRI | ||||||||||||
| 10/03 | SAT | ||||||||||||
| 10/04 | SUN | ||||||||||||
| 10/05 | MON | ||||||||||||
| 10/06 | TUE | ||||||||||||
| 10/07 | WED | ||||||||||||
| 10/08 | THU | ||||||||||||
| 10/09 | FRI | ||||||||||||
| 10/10 | SAT | 5:55 | 14:58 | ||||||||||
| 10/11 | SUN | 5:58 | 14:58 | ||||||||||
| 10/12 | MON | 5:57 | 14:49 | ||||||||||
| 10/13 | TUE | 0:00 | 0:00 | ||||||||||
| 10/14 | WED | 14:24 | 21:01 | ||||||||||
| 10/15 | THU | 14:15 | 20:15 | ||||||||||
| 10/16 | FRI | 0:00 | 0:00 | ||||||||||
| 10/17 | SAT | 0:00 | 0:00 | ||||||||||
| 10/18 | SUN | 0:00 | 0:00 | ||||||||||
| 10/19 | MON | 0:00 | 0:00 | ||||||||||
| 10/20 | TUE | 0:00 | 0:00 | ||||||||||
| 10/21 | WED | 14:25 | 21:51 | ||||||||||
| 10/22 | THU | 14:18 | 21:03 | ||||||||||
| 10/23 | FRI | 0:00 | 0:00 | ||||||||||
| 10/24 | SAT | 6:00 | 15:03 | ||||||||||
| 10/25 | SUN | 6:03 | 14:59 | ||||||||||
| 10/26 | MON | 0:00 | 0:00 | ||||||||||
| 10/27 | TUE | 0:00 | 0:00 | ||||||||||
| 10/28 | WED | 0:00 | 0:00 | ||||||||||
| 10/29 | THU | 0:00 | 0:00 | ||||||||||
| 10/30 | FRI | 0:00 | 0:00 | ||||||||||
| TOTAL: | |||||||||||||
| Work Total (hrs): | Overtime (hrs) | Other (hrs): | Total (hrs): | ||||||||||
| Employee Signature: | Manager Signature: | Date: | |||||||||||
| No: 490794 | Name: NAME | Dept: | Shift: NULL | Daily totals | |||||||||
| Date | Week | (IN) | (OUT) | (IN) | (OUT) | (IN) | (OUT) | (IN) | (OUT) | Regular Hours | OT Hours | Other Hours | Notes |
| 10/01 | THU | ||||||||||||
| 10/02 | FRI | ||||||||||||
| 10/03 | SAT | ||||||||||||
| 10/04 | SUN | ||||||||||||
| 10/05 | MON | ||||||||||||
| 10/06 | TUE | ||||||||||||
| 10/07 | WED | ||||||||||||
| 10/08 | THU | 14:18 | |||||||||||
| 10/09 | FRI | 6:27 | 17:14 | ||||||||||
| 10/10 | SAT | 0:00 | 0:00 | ||||||||||
| 10/11 | SUN | 0:00 | 0:00 | ||||||||||
| 10/12 | MON | 6:30 | 17:34 | ||||||||||
| 10/13 | TUE | 6:19 | 19:09 | ||||||||||
| 10/14 | WED | 9:55 | 11:30 | ||||||||||
| 10/15 | THU | 0:00 | 0:00 | ||||||||||
| 10/16 | FRI | 0:00 | 0:00 | ||||||||||
| 10/17 | SAT | 0:00 | 0:00 | ||||||||||
| 10/18 | SUN | 0:00 | 0:00 | ||||||||||
| 10/19 | MON | 6:26 | 17:31 | ||||||||||
| 10/20 | TUE | 6:33 | 17:07 | ||||||||||
| 10/21 | WED | 0:00 | 0:00 | ||||||||||
| 10/22 | THU | 6:28 | 18:33 | ||||||||||
| 10/23 | FRI | 6:25 | 17:32 | ||||||||||
| 10/24 | SAT | 0:00 | 0:00 | ||||||||||
| 10/25 | SUN | 0:00 | 0:00 | ||||||||||
| 10/26 | MON | 6:31 | 18:18 | ||||||||||
| 10/27 | TUE | 6:24 | |||||||||||
| 10/28 | WED | 0:00 | |||||||||||
| 10/29 | THU | 0:00 | |||||||||||
| 10/30 | FRI | 0:00 | |||||||||||
| TOTAL: | |||||||||||||
| Work Total (hrs): | Overtime (hrs) | Other (hrs): | Total (hrs): | ||||||||||
| Employee Signature: | Manager Signature: | Date: |
<tbody>
</tbody>
HERE IS THE VBA CODE TO CALCULATE THE HOURS
Code:
' BioTouch Totals
Const FirstPunchColumn = 3
Const cTotalsColumn = 11
Sub CalculateTimeCards()
formGetFormat.Show
End Sub
Sub CalcTimeCards(bHundredths As Boolean)
'Application.ScreenUpdating = False
Dim nRow As Integer
Dim dtIn As Date
Dim dtOut As Date
Dim dDayTotal As Double
Dim dPeriodTotal As Double
Dim bOut As Boolean
On Error GoTo ErrorHandler
BlankCount = 0
nRow = 4
With Worksheets("Sheet1")
Do While BlankCount < 10
If .Cells(nRow, 1) = "" Then
BlankCount = BlankCount + 1
Else
If Left(.Cells(nRow, 1), 3) = "No:" Then
BlankCount = 0
dPeriodTotal = 0
' Get the punch data
nRow = nRow + 2
Do While Trim(.Cells(nRow, 1)) <> ""
nCol = FirstPunchColumn
dDayTotal = 0
bOut = False
If Trim(.Cells(nRow, nCol)) = "" Then
.Cells(nRow, cTotalsColumn) = ""
Else
' Iterate the timecard columns
Do While Trim(.Cells(nRow, nCol)) <> ""
' Get the punch
If Not bOut Then
dtIn = .Cells(nRow, nCol)
bOut = True
Else
dtOut = .Cells(nRow, nCol)
dDayTotal = dDayTotal + (dtOut - dtIn)
If dtOut < dtIn Then
' Crossed midnight. Add a day
dDayTotal = dDayTotal + 1
End If
bOut = False
End If
nCol = nCol + 1
Loop
If Not bOut Then
If bHundredths Then
.Cells(nRow, cTotalsColumn).NumberFormat = "0.00"
.Cells(nRow, cTotalsColumn) = 24 * dDayTotal
Else
.Cells(nRow, cTotalsColumn).NumberFormat = "[h]:mm"
.Cells(nRow, cTotalsColumn) = HoursAndMins(dDayTotal)
End If
dPeriodTotal = dPeriodTotal + dDayTotal
Else
.Cells(nRow, cTotalsColumn) = "MP"
End If
End If
nRow = nRow + 1
Loop
.Cells(nRow, cTotalsColumn).HorizontalAlignment = xlCenter
If bHundredths Then
.Cells(nRow, cTotalsColumn).NumberFormat = "0.00"
.Cells(nRow, cTotalsColumn) = 24 * dPeriodTotal
Else
.Cells(nRow, cTotalsColumn).NumberFormat = "[h]:mm"
.Cells(nRow, cTotalsColumn) = HoursAndMins(dPeriodTotal)
End If
End If
End If
nRow = nRow + 1
Loop
End With
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "Problem accessing the Time Card Spreadsheet. Make sure that the time cards are opened in the same " & _
"Excel instance as this macro", vbOKOnly, "Error"
Exit Sub
End Sub
Function HoursAndMins(ByVal d As Double) As String
Dim Hours As Integer
Dim Min As Integer
Dim str1 As String
d = d * 24
Hours = Int(d)
Min = Round((d - Hours) * 60, 0)
If Len(Min) < 2 Then
HoursAndMins = Hours & ":0" & Min
Else
HoursAndMins = Hours & ":" & Min
End If
End Function
Last edited by a moderator:
