Creating Own Function(VBA)
Whenever employees use PTO or WFH, I wanted to track how often they used PTO and WFH.
Here is the function that I created. it would be helpful to track their usages to compare monthly and check out how it works in excel.
In the calender, make employee groups dropdown list, Type list and hours list.
Assign the fucntions that I created to each person.
See how it looks.
One of employees is exculsively working from home on year to date.
See how to create the each functions.
Function PTOSUM(value1) As Integer
'To update automactically the functions
Application.Volatile
Dim RngSumMar1 As Range
Dim RngcreteriaMarE As Range
Dim RngcreteriaMarF As Range
Dim Functionsum As Integer
Dim DaySumMar1 As Integer
Dim DaySumMar2 As Integer
Dim DaySumMar3 As Integer
Dim DaySumMar4 As Integer
Dim DaySumMar5 As Integer
'To select all the range that I want to sum up for the person and specific criteria.
Set RngSumMar1 = Range("Mar!G:G")
Set RngcreteriaMarE = Range("Mar!E:E")
Set RngcreteriaMarF = Range("Mar!F:F")
Set RngSumMar2 = Range("Mar!J:J")
Set RngcreteriaMarH = Range("Mar!H:H")
Set RngcreteriaMarI = Range("Mar!I:I")
Set RngSumMar3 = Range("Mar!M:M")
Set RngcreteriaMarK = Range("Mar!K:K")
Set RngcreteriaMarL = Range("Mar!L:L")
Set RngSumMar4 = Range("Mar!P:P")
Set RngcreteriaMarN = Range("Mar!N:N")
Set RngcreteriaMarO = Range("Mar!O:O")
Set RngSumMar5 = Range("Mar!S:S")
Set RngcreteriaMarQ = Range("Mar!Q:Q")
Set RngcreteriaMarR = Range("Mar!R:R")
Set RngSumApr1 = Range("Apr!G:G")
Set RngcreteriaAprE = Range("Apr!E:E")
Set RngcreteriaAprF = Range("Apr!F:F")
Set RngSumApr2 = Range("Apr!J:J")
Set RngcreteriaAprH = Range("Apr!H:H")
Set RngcreteriaAprI = Range("Apr!I:I")
Set RngSumApr3 = Range("Apr!M:M")
Set RngcreteriaAprK = Range("Apr!K:K")
Set RngcreteriaAprL = Range("Apr!L:L")
Set RngSumApr4 = Range("Apr!P:P")
Set RngcreteriaAprN = Range("Apr!N:N")
Set RngcreteriaAprO = Range("Apr!O:O")
Set RngSumApr5 = Range("Apr!S:S")
Set RngcreteriaAprQ = Range("Apr!Q:Q")
Set RngcreteriaAprR = Range("Apr!R:R")
Set RngSumMay1 = Range("May!G:G")
Set RngcreteriaMayE = Range("May!E:E")
Set RngcreteriaMayF = Range("May!F:F")
Set RngSumMay2 = Range("May!J:J")
Set RngcreteriaMayH = Range("May!H:H")
Set RngcreteriaMayI = Range("May!I:I")
Set RngSumMay3 = Range("May!M:M")
Set RngcreteriaMayK = Range("May!K:K")
Set RngcreteriaMayL = Range("May!L:L")
Set RngSumMay4 = Range("May!P:P")
Set RngcreteriaMayN = Range("May!N:N")
Set RngcreteriaMayO = Range("May!O:O")
Set RngSumMay5 = Range("May!S:S")
Set RngcreteriaMayQ = Range("May!Q:Q")
Set RngcreteriaMayR = Range("May!R:R")
Set RngSumJun1 = Range("Jun!G:G")
Set RngcreteriaJunE = Range("Jun!E:E")
Set RngcreteriaJunF = Range("Jun!F:F")
Set RngSumJun2 = Range("Jun!J:J")
Set RngcreteriaJunH = Range("Jun!H:H")
Set RngcreteriaJunI = Range("Jun!I:I")
Set RngSumJun3 = Range("Jun!M:M")
Set RngcreteriaJunK = Range("Jun!K:K")
Set RngcreteriaJunL = Range("Jun!L:L")
Set RngSumJun4 = Range("Jun!P:P")
Set RngcreteriaJunN = Range("Jun!N:N")
Set RngcreteriaJunO = Range("Jun!O:O")
Set RngSumJun5 = Range("Jun!S:S")
Set RngcreteriaJunQ = Range("Jun!Q:Q")
Set RngcreteriaJunR = Range("Jun!R:R")
Set RngSumJul1 = Range("Jul!G:G")
Set RngcreteriaJulE = Range("Jul!E:E")
Set RngcreteriaJulF = Range("Jul!F:F")
Set RngSumJul2 = Range("Jul!J:J")
Set RngcreteriaJulH = Range("Jul!H:H")
Set RngcreteriaJulI = Range("Jul!I:I")
Set RngSumJul3 = Range("Jul!M:M")
Set RngcreteriaJulK = Range("Jul!K:K")
Set RngcreteriaJulL = Range("Jul!L:L")
Set RngSumJul4 = Range("Jul!P:P")
Set RngcreteriaJulN = Range("Jul!N:N")
Set RngcreteriaJulO = Range("Jul!O:O")
Set RngSumJul5 = Range("Jul!S:S")
Set RngcreteriaJulQ = Range("Jul!Q:Q")
Set RngcreteriaJulR = Range("Jul!R:R")
Set RngSumAug1 = Range("Aug!G:G")
Set RngcreteriaAugE = Range("Aug!E:E")
Set RngcreteriaAugF = Range("Aug!F:F")
Set RngSumAug2 = Range("Aug!J:J")
Set RngcreteriaAugH = Range("Aug!H:H")
Set RngcreteriaAugI = Range("Aug!I:I")
Set RngSumAug3 = Range("Aug!M:M")
Set RngcreteriaAugK = Range("Aug!K:K")
Set RngcreteriaAugL = Range("Aug!L:L")
Set RngSumAug4 = Range("Aug!P:P")
Set RngcreteriaAugN = Range("Aug!N:N")
Set RngcreteriaAugO = Range("Aug!O:O")
Set RngSumAug5 = Range("Aug!S:S")
Set RngcreteriaAugQ = Range("Aug!Q:Q")
Set RngcreteriaAugR = Range("Aug!R:R")
'To use worksheetfunction to execute Sumif function in VBA.
DaySumMar1 = WorksheetFunction.SumIfs(RngSumMar1, RngcreteriaMarE, value1, RngcreteriaMarF, "PTO")
DaySumMar2 = WorksheetFunction.SumIfs(RngSumMar2, RngcreteriaMarH, value1, RngcreteriaMarI, "PTO")
DaySumMar3 = WorksheetFunction.SumIfs(RngSumMar3, RngcreteriaMarK, value1, RngcreteriaMarL, "PTO")
DaySumMar4 = WorksheetFunction.SumIfs(RngSumMar4, RngcreteriaMarN, value1, RngcreteriaMarO, "PTO")
DaySumMar5 = WorksheetFunction.SumIfs(RngSumMar5, RngcreteriaMarQ, value1, RngcreteriaMarR, "PTO")
DaySumApr1 = WorksheetFunction.SumIfs(RngSumApr1, RngcreteriaAprE, value1, RngcreteriaAprF, "PTO")
DaySumApr2 = WorksheetFunction.SumIfs(RngSumApr2, RngcreteriaAprH, value1, RngcreteriaAprI, "PTO")
DaySumApr3 = WorksheetFunction.SumIfs(RngSumApr3, RngcreteriaAprK, value1, RngcreteriaAprL, "PTO")
DaySumApr4 = WorksheetFunction.SumIfs(RngSumApr4, RngcreteriaAprN, value1, RngcreteriaAprO, "PTO")
DaySumApr5 = WorksheetFunction.SumIfs(RngSumApr5, RngcreteriaAprQ, value1, RngcreteriaAprR, "PTO")
DaySumMay1 = WorksheetFunction.SumIfs(RngSumMay1, RngcreteriaMayE, value1, RngcreteriaMayF, "PTO")
DaySumMay2 = WorksheetFunction.SumIfs(RngSumMay2, RngcreteriaMayH, value1, RngcreteriaMayI, "PTO")
DaySumMay3 = WorksheetFunction.SumIfs(RngSumMay3, RngcreteriaMayK, value1, RngcreteriaMayL, "PTO")
DaySumMay4 = WorksheetFunction.SumIfs(RngSumMay4, RngcreteriaMayN, value1, RngcreteriaMayO, "PTO")
DaySumMay5 = WorksheetFunction.SumIfs(RngSumMay5, RngcreteriaMayQ, value1, RngcreteriaMayR, "PTO")
DaySumJun1 = WorksheetFunction.SumIfs(RngSumJun1, RngcreteriaJunE, value1, RngcreteriaJunF, "PTO")
DaySumJun2 = WorksheetFunction.SumIfs(RngSumJun2, RngcreteriaJunH, value1, RngcreteriaJunI, "PTO")
DaySumJun3 = WorksheetFunction.SumIfs(RngSumJun3, RngcreteriaJunK, value1, RngcreteriaJunL, "PTO")
DaySumJun4 = WorksheetFunction.SumIfs(RngSumJun4, RngcreteriaJunN, value1, RngcreteriaJunO, "PTO")
DaySumJun5 = WorksheetFunction.SumIfs(RngSumJun5, RngcreteriaJunQ, value1, RngcreteriaJunR, "PTO")
DaySumJul1 = WorksheetFunction.SumIfs(RngSumJul1, RngcreteriaJulE, value1, RngcreteriaJulF, "PTO")
DaySumJul2 = WorksheetFunction.SumIfs(RngSumJul2, RngcreteriaJulH, value1, RngcreteriaJulI, "PTO")
DaySumJul3 = WorksheetFunction.SumIfs(RngSumJul3, RngcreteriaJulK, value1, RngcreteriaJulL, "PTO")
DaySumJul4 = WorksheetFunction.SumIfs(RngSumJul4, RngcreteriaJulN, value1, RngcreteriaJulO, "PTO")
DaySumJul5 = WorksheetFunction.SumIfs(RngSumJul5, RngcreteriaJulQ, value1, RngcreteriaJulR, "PTO")
DaySumAug1 = WorksheetFunction.SumIfs(RngSumAug1, RngcreteriaAugE, value1, RngcreteriaAugF, "PTO")
DaySumAug2 = WorksheetFunction.SumIfs(RngSumAug2, RngcreteriaAugH, value1, RngcreteriaAugI, "PTO")
DaySumAug3 = WorksheetFunction.SumIfs(RngSumAug3, RngcreteriaAugK, value1, RngcreteriaAugL, "PTO")
DaySumAug4 = WorksheetFunction.SumIfs(RngSumAug4, RngcreteriaAugN, value1, RngcreteriaAugO, "PTO")
DaySumAug5 = WorksheetFunction.SumIfs(RngSumAug5, RngcreteriaAugQ, value1, RngcreteriaAugR, "PTO")
'Set RngSumMar1 = Nothing
'Set RngcretreiaMarE = Nothing
'Set RngcretreiaMarF = Nothing
'To sum all the values above and make it as a function in excel.
PTOSUM = DaySumMar1 + DaySumMar2 + DaySumMar3 + DaySumMar4 + DaySumMar5 + DaySumApr1 + DaySumApr2 + DaySumApr3 + DaySumApr4 + DaySumApr5 + DaySumMay1 + DaySumMay2 + DaySumMay3 + DaySumMay4 + DaySumMay5 + DaySumJun1 + DaySumJun2 + DaySumJun3 + DaySumJun4 + DaySumJun5 + DaySumJul1 + DaySumJul2 + DaySumJul3 + DaySumJul4 + DaySumJul5 + DaySumAug1 + DaySumAug2 + DaySumAug3 + DaySumAug4 + DaySumAug5
End Function
Function PTOWEEKSUM(Range1 As Range, value1) As Integer
Application.Volatile
'Dim Range1 As Range
'Set Range1 = Selection
Set Rngsum1 = Range1.Columns("G:G")
Set RngcreteriaE = Range1.Columns("E:E")
Set RngcreteriaF = Range1.Columns("F:F")
Set Rngsum2 = Range1.Columns("J:J")
Set RngcreteriaH = Range1.Columns("H:H")
Set RngcreteriaI = Range1.Columns("I:I")
Set Rngsum3 = Range1.Columns("M:M")
Set RngcreteriaK = Range1.Columns("K:K")
Set RngcreteriaL = Range1.Columns("L:L")
Set Rngsum4 = Range1.Columns("P:P")
Set RngcreteriaN = Range1.Columns("N:N")
Set RngcreteriaO = Range1.Columns("O:O")
Set Rngsum5 = Range1.Columns("S:S")
Set RngcreteriaQ = Range1.Columns("Q:Q")
Set RngcreteriaR = Range1.Columns("R:R")
DaySum1 = WorksheetFunction.SumIfs(Rngsum1, RngcreteriaE, value1, RngcreteriaF, "PTO")
DaySum2 = WorksheetFunction.SumIfs(Rngsum2, RngcreteriaH, value1, RngcreteriaI, "PTO")
DaySum3 = WorksheetFunction.SumIfs(Rngsum3, RngcreteriaK, value1, RngcreteriaL, "PTO")
DaySum4 = WorksheetFunction.SumIfs(Rngsum4, RngcreteriaN, value1, RngcreteriaO, "PTO")
DaySum5 = WorksheetFunction.SumIfs(Rngsum5, RngcreteriaQ, value1, RngcreteriaR, "PTO")
PTOWEEKSUM = DaySum1 + DaySum2 + DaySum3 + DaySum4 + DaySum5
End Function
Function WFHWEEKSUM(Range1 As Range, value1) As Integer
Application.Volatile
'Dim Range1 As Range
'Set Range1 = Selection
Set Rngsum1 = Range1.Columns("G:G")
Set RngcreteriaE = Range1.Columns("E:E")
Set RngcreteriaF = Range1.Columns("F:F")
Set Rngsum2 = Range1.Columns("J:J")
Set RngcreteriaH = Range1.Columns("H:H")
Set RngcreteriaI = Range1.Columns("I:I")
Set Rngsum3 = Range1.Columns("M:M")
Set RngcreteriaK = Range1.Columns("K:K")
Set RngcreteriaL = Range1.Columns("L:L")
Set Rngsum4 = Range1.Columns("P:P")
Set RngcreteriaN = Range1.Columns("N:N")
Set RngcreteriaO = Range1.Columns("O:O")
Set Rngsum5 = Range1.Columns("S:S")
Set RngcreteriaQ = Range1.Columns("Q:Q")
Set RngcreteriaR = Range1.Columns("R:R")
DaySum1 = WorksheetFunction.SumIfs(Rngsum1, RngcreteriaE, value1, RngcreteriaF, "WFH")
DaySum2 = WorksheetFunction.SumIfs(Rngsum2, RngcreteriaH, value1, RngcreteriaI, "WFH")
DaySum3 = WorksheetFunction.SumIfs(Rngsum3, RngcreteriaK, value1, RngcreteriaL, "WFH")
DaySum4 = WorksheetFunction.SumIfs(Rngsum4, RngcreteriaN, value1, RngcreteriaO, "WFH")
DaySum5 = WorksheetFunction.SumIfs(Rngsum5, RngcreteriaQ, value1, RngcreteriaR, "WFH")
WFHWEEKSUM = DaySum1 + DaySum2 + DaySum3 + DaySum4 + DaySum5
End Function
Function UNPAIDWEEKSUM(Range1 As Range, value1) As Integer
Application.Volatile
'Dim Range1 As Range
'Set Range1 = Selection
Set Rngsum1 = Range1.Columns("G:G")
Set RngcreteriaE = Range1.Columns("E:E")
Set RngcreteriaF = Range1.Columns("F:F")
Set Rngsum2 = Range1.Columns("J:J")
Set RngcreteriaH = Range1.Columns("H:H")
Set RngcreteriaI = Range1.Columns("I:I")
Set Rngsum3 = Range1.Columns("M:M")
Set RngcreteriaK = Range1.Columns("K:K")
Set RngcreteriaL = Range1.Columns("L:L")
Set Rngsum4 = Range1.Columns("P:P")
Set RngcreteriaN = Range1.Columns("N:N")
Set RngcreteriaO = Range1.Columns("O:O")
Set Rngsum5 = Range1.Columns("S:S")
Set RngcreteriaQ = Range1.Columns("Q:Q")
Set RngcreteriaR = Range1.Columns("R:R")
DaySum1 = WorksheetFunction.SumIfs(Rngsum1, RngcreteriaE, value1, RngcreteriaF, "UNPAID")
DaySum2 = WorksheetFunction.SumIfs(Rngsum2, RngcreteriaH, value1, RngcreteriaI, "UNPAID")
DaySum3 = WorksheetFunction.SumIfs(Rngsum3, RngcreteriaK, value1, RngcreteriaL, "UNPAID")
DaySum4 = WorksheetFunction.SumIfs(Rngsum4, RngcreteriaN, value1, RngcreteriaO, "UNPAID")
DaySum5 = WorksheetFunction.SumIfs(Rngsum5, RngcreteriaQ, value1, RngcreteriaR, "UNPAID")
UNPAIDWEEKSUM = DaySum1 + DaySum2 + DaySum3 + DaySum4 + DaySum5
End Function