Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Function Cnv3LMonthToNum(cnvMonth As String) As String
If cnvMonth = "Jan" Then
Cnv3LMonthToNum = "01"
ElseIf cnvMonth = "Feb" Then
Cnv3LMonthToNum = "02"
ElseIf cnvMonth = "Mar" Then
Cnv3LMonthToNum = "03"
ElseIf cnvMonth = "Apr" Then
Cnv3LMonthToNum = "04"
ElseIf cnvMonth = "May" Then
Cnv3LMonthToNum = "05"
ElseIf cnvMonth = "Jun" Then
Cnv3LMonthToNum = "06"
ElseIf cnvMonth = "Jul" Then
Cnv3LMonthToNum = "07"
ElseIf cnvMonth = "Aug" Then
Cnv3LMonthToNum = "08"
ElseIf cnvMonth = "Sep" Then
Cnv3LMonthToNum = "09"
ElseIf cnvMonth = "Oct" Then
Cnv3LMonthToNum = "10"
ElseIf cnvMonth = "Nov" Then
Cnv3LMonthToNum = "11"
ElseIf cnvMonth = "Dec" Then
Cnv3LMonthToNum = "12"
Else: Cnv3LMonthToNum = CVErr(xlErrNA)
End If
End Function
Function IsArrayEmpty(arr As Variant) As Boolean
On Error Resume Next
IsArrayEmpty = True
IsArrayEmpty = UBound(arr) < LBound(arr)
End Function
Sub Payroll()
'Get emplyees' names
Dim pr As Worksheet, wsCnt As Long, namesRow As Long, namesCnt As Long, iLoop As Long, i As Long, employees() As String, colors() As Long
Set pr = Sheets("Payroll")
wsCnt = ActiveWorkbook.Worksheets.Count - 2 'EDIT THIS NUMBER ACCORDING TO THE NUMBER OF SHEETS THAT START WITH AN ALPHABET
'Now it's 2 because we have sheets named "Payroll" and "WagePerHour"
namesRow = Sheets(wsCnt).Range("H" & Rows.Count).End(xlUp).Row
namesCnt = (namesRow - 1) / 10
iLoop = 0
For i = 0 To namesCnt - 1
ReDim Preserve employees(i)
ReDim Preserve colors(i)
employees(i) = Sheets(wsCnt).Range("A" & 2 + iLoop)
colors(i) = Sheets(wsCnt).Range("A" & 2 + iLoop).Font.ColorIndex
iLoop = iLoop + 10
Next i
'====Set employees()
'Get weeks already on sheet "Payroll"
Dim weeks() As String, fnd As Range, tempFnd As Range
Set fnd = pr.Range("C:C").Find("*", pr.Range("C3"), xlValues)
Set tempFnd = fnd
i = 0
Do While Not fnd Is Nothing
ReDim Preserve weeks(i)
If fnd <> "Week Ending" Then weeks(i) = fnd
Set fnd = pr.Range("C:C").FindNext(fnd)
If fnd.Address = tempFnd.Address Then
Exit Do
End If
i = i + 1
Loop
'====Set weeks()
'Get sheet names
Dim shNames() As String, DBQ As String
DBQ = """"
For i = 0 To wsCnt - 1
ReDim Preserve shNames(i)
If Sheets(i + 1).Name <> "Payroll" Then
shNames(i) = Sheets(i + 1).Name
If Len(shNames(i)) = 8 Then
shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 3, 3)) & "/" & "0" & Left(shNames(i), 1) & "/" & Right(shNames(i), 2)
ElseIf Len(shNames(i)) = 9 Then
shNames(i) = Cnv3LMonthToNum(Mid(shNames(i), 4, 3)) & "/" & Left(shNames(i), 2) & "/" & Right(shNames(i), 2)
Else
MsgBox "There are sheets that are not named in the form" & DBQ & "(d)d-Mmm-yy" & DBQ, vbExclamation, "Error"
Exit Sub
End If
End If
Next i
'====Set shNames()
'Get weeks not on sheet "Payroll"
Dim nWeeks() As String, j As Long
j = 0
For i = LBound(shNames) To UBound(shNames)
If IsInArray(shNames(i), weeks) = False Then
ReDim Preserve nWeeks(j)
nWeeks(j) = shNames(i)
j = j + 1
End If
Next i
'====Set nWeeks()
If IsArrayEmpty(nWeeks) = True Then 'Show error message if there's no data to output to Payroll
MsgBox "The sheet " & DBQ & "Payroll" & DBQ & " already has all the data available.", vbExclamation, "Error"
Exit Sub
End If
'Output values into sheet "Payroll"
Dim outputRow As Long, msg As Long, srcWs As Worksheet, fndWage As Range, wage As Single
For i = LBound(nWeeks) To UBound(nWeeks)
msg = MsgBox("Would you like to add data for the week ending:" & vbCrLf & vbCrLf & MonthName(Left(nWeeks(i), 2)) & " " _
& Mid(nWeeks(i), 4, 2) & " 20" & Right(nWeeks(i), 2), vbYesNo, "Confirmation")
If msg = vbYes Then
Application.ScreenUpdating = False
outputRow = pr.Range("A" & Rows.Count).End(xlUp).Row + 3
If Val(Mid(nWeeks(i), 4, 2)) >= 10 Then
Set srcWs = Sheets(Mid(nWeeks(i), 4, 2) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
Else
Set srcWs = Sheets(Mid(nWeeks(i), 5, 1) & "-" & Left(MonthName(Left(nWeeks(i), 2)), 3) & "-" & Right(nWeeks(i), 2))
End If
For j = LBound(employees) To UBound(employees)
Set fndWage = Sheets("WagePerHour").Range("2:3").Find(employees(j), , xlValues, xlWhole, xlByRows)
If fndWage Is Nothing Then
MsgBox "Wage per hour for the following employee is not specified:" & vbCrLf & vbCrLf & employees(j), vbExclamation, "Error"
Exit Sub
Else
wage = Sheets("WagePerHour").Range("A" & fndWage.Row)
pr.Range("A" & outputRow + j) = employees(j)
pr.Range("A" & outputRow + j).Font.ColorIndex = colors(j)
pr.Range("B" & outputRow + j) = srcWs.Range("H" & 10 * (j + 1) + 1) 'H11, H21, H31...
pr.Range("D" & outputRow + j) = "$" & Val(pr.Range("B" & outputRow + j)) * wage
End If
Next j
pr.Range("C" & outputRow) = nWeeks(i)
pr.Range("E" & outputRow) = "=SUM(D" & outputRow & ":" & "D" & outputRow + UBound(employees) & ")"
pr.Range(Cells(outputRow, "A"), Cells(outputRow + UBound(employees), "E")).BorderAround Weight:=xlThin
Application.ScreenUpdating = True
End If
If Not i = UBound(nWeeks) Then
msg = MsgBox("There's more data available for output. Would you like to proceed to the next week?", vbYesNo, "Confirmation")
If msg = vbNo Then
Exit Sub
End If
End If
Next i
End Sub