VBA array Function help

Hi All,

I'm struggling with a particular issue that I dont seem to be able to resolve.

in the attached workbook there is a simple time sheet arrangement whereby there is a name, which is arranged in a column, a date row across the top, and hours are inserted against each day worked.

there is a rather tricky chargeout structure which I'm trying to accommodate in a function. I've managed to do a formula but it is very large, and also needs a second row at the minute because Ive not managed to convert it into an array.

the target is to have one cell contain a total charge out value, in a column next to the column containing the name, without having to have subtotals etc

I thought I'd just about cracked the code for a single calculation (which would need a subtotal) but the function just returns a value error. i'm new to VBA and really struggling to see where I've gone wrong, and where to start to turn this into an array using the date and hours as arrays, and the name as a fixed value.

any help would be very gratefully received

regards

OK, this gives an answer, not sure if it's the right answer.

Option Explicit

'function to calculate charges for employees
'using the employees name, the date on which work was carried out, and the hours worked as variables

Function MyPay(myname As String, mydate As Date, myhours As Variant)

Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim Myday As Integer
Dim Normalhours As Long
Dim Overtime1hours As Long
Dim Overtime2hours As Long
Dim Hoursworked As Long
Dim Holidays As Range
Dim Normalrate As Long
Dim OT1rate As Long
Dim OT2rate As Long

' the intention is to lookup the employees nam in a range which is containes in the workbook called "Labour_Rates"
' column 1 contains teh name, column 2 contains the basic rate, colunm 3, the first level overtime,
' and column 4 the upper level rate

Normalrate = awf.VLookup(myname, Range("Labour_Rates"), 2, False)
OT1rate = awf.VLookup(myname, Range("Labour_Rates"), 3, False)
OT2rate = awf.VLookup(myname, Range("Labour_Rates"), 4, False)

' there is also a named range called "Holidays",
' this contains bank holidays which carries the upper
' level rate if any work is carried out on that date.

Set Holidays = Range("Holidays")

' the charging structure depends on the weekday,
' thus the following intends to extract the date of
' the week from the variable "mydate"

Myday = Weekday(mydate)

' sometimes the cell containing the variable "myhours"
' is blank, I need these to calculate as zero's

If myhours = "" Then
    Hoursworked = 0
    Else: Hoursworked = CDbl(myhours)
End If

' this section details the charging structure.
' (myday 1) being a Sunday, on which al hours worked
' are charged at(OT2rate)
' the Dim of normalhours - OT1hours - OT2 Hours
' changes depending on the working day in the
' variable "Mydate"

' first though I need to decide if "mydate" is a
' holiday listed in the named range "Holidays"

Dim vHol
On Error Resume Next
vHol = awf.Match(mydate, Holidays, 0)
On Error GoTo 0

'If awf.IsError(awf.Match(mydate, Holidays, 0)) Then
If vHol = "" Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf Myday = 1 Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf awf.Or(Myday = 2, Myday = 3, Myday = 4, Myday = 5) Then
    Normalhours = awf.Min(Hoursworked, 8)
    Overtime1hours = awf.Max(0, Hoursworked - 8)
    Overtime2hours = 0
ElseIf Myday = 6 Then
    Normalhours = awf.Min(Hoursworked, 7)
    Overtime1hours = awf.Max(0, Hoursworked - 7)
    Overtime2hours = 0
ElseIf Myday = 7 Then
    Normalhours = 0
    Overtime1hours = awf.Min(Hoursworked, 5)
    Overtime2hours = awf.Max(0, Hoursworked - 5)
End If
       
' then the bit that calculates ......

MyPay = (Normalhours * Normalrate) + _
        (Overtime1hours * OT1rate) + _
        (Overtime2hours * OT2rate)

End Function

Regards, TMS

No, no intentional changes to your code. The only "big" change was to the check for a holiday date. You probably need to do some more exhaustive testing

Right, this version works and gives the right answers for the sample data.

Option Explicit

'function to calculate charges for employees
'using the employees name, the date on which work was carried out, and the hours worked as variables

Function MyPay(myname As String, mydate As Date, myhours As Variant)

Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim Myday As Integer
Dim Normalhours As Double
Dim Overtime1hours As Double
Dim Overtime2hours As Double
Dim Hoursworked As Double
Dim Holidays As Range
Dim Normalrate As Double
Dim OT1rate As Double
Dim OT2rate As Double

' the intention is to lookup the employees nam in a range which is containes in the workbook called "Labour_Rates"
' column 1 contains the name, column 2 contains the basic rate, colunm 3, the first level overtime,
' and column 4 the upper level rate

Normalrate = awf.VLookup(myname, Range("Labour_Rates"), 2, False)
OT1rate = awf.VLookup(myname, Range("Labour_Rates"), 3, False)
OT2rate = awf.VLookup(myname, Range("Labour_Rates"), 4, False)

' there is also a named range called "Holidays",
' this contains bank holidays which carries the upper
' level rate if any work is carried out on that date.

Set Holidays = Range("Holidays")

' the charging structure depends on the weekday,
' thus the following intends to extract the date of
' the week from the variable "mydate"

Myday = Weekday(mydate)

' sometimes the cell containing the variable "myhours"
' is blank, I need these to calculate as zero's

If myhours = "" Then
    Hoursworked = 0
    Else: Hoursworked = CDbl(myhours)
End If

' this section details the charging structure.
' (myday 1) being a Sunday, on which al hours worked
' are charged at(OT2rate)
' the Dim of normalhours - OT1hours - OT2 Hours
' changes depending on the working day in the
' variable "Mydate"

' first though I need to decide if "mydate" is a
' holiday listed in the named range "Holidays"

Dim vHol
On Error Resume Next
vHol = awf.Match(mydate, Holidays, 0)
On Error GoTo 0

'If awf.IsError(awf.Match(mydate, Holidays, 0)) Then
If vHol <> "" Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf Myday = 1 Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf Myday >= 2 And Myday <= 5 Then
    Normalhours = awf.Min(Hoursworked, 8)
    Overtime1hours = awf.Max(0, Hoursworked - 8)
    Overtime2hours = 0
ElseIf Myday = 6 Then
    Normalhours = awf.Min(Hoursworked, 7)
    Overtime1hours = awf.Max(0, Hoursworked - 7)
    Overtime2hours = 0
ElseIf Myday = 7 Then
    Normalhours = 0
    Overtime1hours = awf.Min(Hoursworked, 5)
    Overtime2hours = awf.Max(0, Hoursworked - 5)
End If
       
'Debug.Print Myday, Hoursworked, Normalhours, Overtime1hours, Overtime2hours
       
' then the bit that calculates ......

MyPay = (Normalhours * Normalrate) + _
        (Overtime1hours * OT1rate) + _
        (Overtime2hours * OT2rate)

End Function

Regards, TMS

Thank you for that.

it didnt quite work when I tested the calc on days which were holidays, but changing the statement " IF vbhol <>"" Then" TO "IF vbhol = 0 Then" did the trick. I assume the "on error goto 0" statement means that if the result (of the check against the holiday days) is an error then return zero?

I'm very grateful for the help you have provided. I've a bit of reading up to do on the code used to deal with the holidays.

If you fancy a challenge, would you know how to alter the code to make it work with an array of dates and times worked? so that the total could (for example) go in B10, and then I could do away with the total price for the day line altogether.

thanks again !

OOps,

Spoke too soon, holidays work but all other days now use OT2 rate too,

I assume the "on error goto 0" statement means that if the result (of the check against the holiday days) is an error then return zero?

No. It switches off the error handling. When you say "On Error Resume Next" you are using one of the resume options which is simply to carry on with the next statement as if the error didn't happen. You can then test the error condition, if you wish, and switch error trapping off, again, if you wish.

Problem was with the holiday lookup. Fixed.

Option Explicit

'function to calculate charges for employees
'using the employees name, the date on which work was carried out, and the hours worked as variables

Function MyPay(myname As String, mydate As Date, myhours As Variant)

Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim Myday As Integer
Dim Normalhours As Double
Dim Overtime1hours As Double
Dim Overtime2hours As Double
Dim Hoursworked As Double
Dim Holidays As Range
Dim Normalrate As Double
Dim OT1rate As Double
Dim OT2rate As Double

' the intention is to lookup the employees nam in a range which is containes in the workbook called "Labour_Rates"
' column 1 contains the name, column 2 contains the basic rate, colunm 3, the first level overtime,
' and column 4 the upper level rate

Normalrate = awf.VLookup(myname, Range("Labour_Rates"), 2, False)
OT1rate = awf.VLookup(myname, Range("Labour_Rates"), 3, False)
OT2rate = awf.VLookup(myname, Range("Labour_Rates"), 4, False)

' there is also a named range called "Holidays",
' this contains bank holidays which carries the upper
' level rate if any work is carried out on that date.

Set Holidays = Range("Holidays")

' the charging structure depends on the weekday,
' thus the following intends to extract the date of
' the week from the variable "mydate"

Myday = Weekday(mydate)

' sometimes the cell containing the variable "myhours"
' is blank, I need these to calculate as zero's

If myhours = "" Then
    Hoursworked = 0
    Else: Hoursworked = CDbl(myhours)
End If

' this section details the charging structure.
' (myday 1) being a Sunday, on which al hours worked
' are charged at(OT2rate)
' the Dim of normalhours - OT1hours - OT2 Hours
' changes depending on the working day in the
' variable "Mydate"

' first though I need to decide if "mydate" is a
' holiday listed in the named range "Holidays"

Dim vHol As Integer
On Error Resume Next
vHol = 0: vHol = awf.Match(CLng(mydate), Holidays, 0)
On Error GoTo 0

'If awf.IsError(awf.Match(mydate, Holidays, 0)) Then
If vHol <> 0 Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf Myday = 1 Then
    Normalhours = 0
    Overtime1hours = 0
    Overtime2hours = Hoursworked
ElseIf Myday >= 2 And Myday <= 5 Then
    Normalhours = awf.Min(Hoursworked, 8)
    Overtime1hours = awf.Max(0, Hoursworked - 8)
    Overtime2hours = 0
ElseIf Myday = 6 Then
    Normalhours = awf.Min(Hoursworked, 7)
    Overtime1hours = awf.Max(0, Hoursworked - 7)
    Overtime2hours = 0
ElseIf Myday = 7 Then
    Normalhours = 0
    Overtime1hours = awf.Min(Hoursworked, 5)
    Overtime2hours = awf.Max(0, Hoursworked - 5)
End If
       
'Debug.Print mydate, Myday, Hoursworked, Normalhours, Overtime1hours, Overtime2hours
       
' then the bit that calculates ......

MyPay = (Normalhours * Normalrate) + _
        (Overtime1hours * OT1rate) + _
        (Overtime2hours * OT2rate)

End Function

If you fancy a challenge, would you know how to alter the code to make it work with an array of dates and times worked? so that the total could (for example) go in B10, and then I could do away with the total price for the day line altogether.

No, not me, I'm afraid. Could be just another function that loops through the array passing name, date and hours to the existing function. But, for simplicity, I think you'd need to repeat the name for each date/hours pair.


Regards, TMS

You're welcome. Thanks for the rep.

And here is the function you asked for:

Option Explicit

Function MyPayTotals(ByRef rNames As Range, _
                     ByRef rDates As Range, _
                     ByRef rHours As Range)

Dim dTotal As Double
Dim i As Long

For i = 1 To rNames.Cells.Count
    dTotal = dTotal + MyPay(rNames(i), _
                            rDates(i), _
                            rHours(i))
Next 'i

MyPayTotals = dTotal

End Function

Not sure how it is an improvement on what you already have but, what do I know do?


Regards, TMS

Option Explicit

Function MyPayTotalsH(ByRef rName As Range, _
                      ByRef rDates As Range, _
                      ByRef rHours As Range)

Dim dTotal As Double
Dim i As Long

If rName.Cells.Count <> 1 _
Or rDates.Cells.Count <> rHours.Cells.Count Then
    MyPayTotalsH = "Error"
    Exit Function
End If

For i = 1 To rDates.Cells.Count
    dTotal = dTotal + MyPay(rName.Value, _
                            rDates(i), _
                            rHours(i))
Next 'i

MyPayTotalsH = dTotal

End Function

Because the function refers to cell/range references, I would have expected it to adjust and recalculate automatically. However, you could try adding

Application.Volatile

as the first line of code in the function. That should cause it to recalculate when Excel feels a recalculation is in order.


Regards, TMS

@robwebber: and is that different to the code I posted?

Thank you

Please note that you should add Code Tags to post #13.


Regards, TMS