Run user defined function for each row matching criteria of array formula if statement - excel

I made a custom function in Excel VBA:
Option Explicit
Function Units(budgetYear As Integer, birthday As Date, serviceStart As Date, serviceEnd As Date, isMarried As Boolean, isServingAbroad As Boolean) As Double
' in this function all dates are converted to the first day of the date's month to make calculations easier
Dim units As Double: units = 0
' service end date cannot be earlier than service start
If serviceEnd < serviceStart Then
Units = units
Exit Function
End If
Dim firstMonthOfYear As Date: firstMonthOfYear = DateSerial(budgetYear, 1, 1)
Dim lastMonthOfYear As Date: lastMonthOfYear = DateSerial(budgetYear, 12, 1)
Dim newServiceStart As Date: newServiceStart = FirstOfTheMonth(serviceStart)
Dim newServiceEnd As Date: newServiceEnd = FirstOfTheMonth(serviceEnd)
Dim eighteenthBirthday As Date: eighteenthBirthday = DateSerial(year(birthday) + 18, Month(birthday), 1)
Dim thisYearServiceStart As Date: thisYearServiceStart = WorksheetFunction.Max(newServiceStart, firstMonthOfYear)
Dim thisYearServiceEnd As Date: thisYearServiceEnd = WorksheetFunction.Min(newServiceEnd, lastMonthOfYear)
Dim serviceMonthsThisYear As Integer: serviceMonthsThisYear = (Month(thisYearServiceEnd) - Month(thisYearServiceStart)) + 1
' unit multipliers
Dim serviceTypeMultiplier As Integer: serviceTypeMultiplier = 1
If isServingAbroad Then serviceTypeMultiplier = 2
' service must fall in the budget year supplied
If newServiceStart > lastMonthOfYear Or newServiceEnd < firstMonthOfYear Then
Units = units
Exit Function
End If
If isMarried Then
units = serviceMonthsThisYear
ElseIf eighteenthBirthday < thisYearServiceStart Then
' this person is already eighteen in the supplied year
units = serviceMonthsThisYear * 0.5
ElseIf eighteenthBirthday > thisYearServiceEnd Then
' this person is under eighteen in the supplied year
units = serviceMonthsThisYear * 0.25
Else
' this person turns eighteen during the supplied year
Dim underEighteenMonths As Integer: underEighteenMonths = (Month(eighteenthBirthday) - Month(thisYearServiceStart))
Dim overEighteenMonths As Integer: overEighteenMonths = serviceMonthsThisYear - underEighteenMonths
units = (underEighteenMonths * 0.25) + (overEighteenMonths * 0.5)
End If
' multiply units by servingAbroad multiplier
units = units * serviceTypeMultiplier
Units = units
End Function
Private Function FirstOfTheMonth(dateToConvert As Date) As Date
FirstOfTheMonth = DateSerial(year(dateToConvert), Month(dateToConvert), 1)
End Function
I have a lookup table (named Table1):
I want to run the function above on each of the rows that match a certain criteria in the lookup table via an array formula.
I've tried this:
=SUM(IF(Table1[Payee]="Bill",Units(G1,"1/2/2003",Table1[Start],Table1[End],Table1[Status],Table1[Location])))
This just gives me #VALUE.
I want it to do like the SUM function. If I had another column in the lookup table called value, I could do this:
=SUM(IF(Table1[Payee]="Bill",Table1[value]))
And it would sum the value column just for the rows that match the criteria ("Bill").
How can I get the same to work with my custom function? I would prefer not to have to modify the custom function. The array formula should run the custom function for each row that matches the criteria. Am I misunderstanding how array functions work in Excel?
Edit:
Just in case it makes a difference, I'm using the latest version of Excel from Office 365 on a Mac.
Edit 2:
Added the full code from the function. Basically the function takes the months served in the budgetYear and applies a weight to them. Months under eighteen get 0.25 weight, months eighteen or older get 0.5 weight, and married gets 1 weight. If isServingAbroad is TRUE, the result gets multiplied by 2.

Related

Find value in column where running total is equal to a certain percentage

In Excel I have a list of values (in random order), where I want to figure out which values that comprise 75% of the total value; i.e. if adding the largest values together, which ones should I include in order to get to 75% of the total (largest to smallest). I would like to find the "cut-off value", i.e. the smallest number to include in the group of values (that combined sum up to 75%). However I want to do this without first sorting my data.
Consider below example, here we can see that the cutoff is at "Company 6", which corresponds to a "cut-off value" of 750.
The data I have is not sorted, hence I just want to figure out what the "cut-off value" should be, because then I know that if the amount in the row is above that number, it is part of group of values that constitute 75% of the total.
The answer can be either Excel or VBA; but I want to avoid having to sort my table first, and I want to avoid having a calculation in each row (so ideally a single formula that can calculate it).
Row number
Amount
Percentage
Running Total
Company 1
1,000
12.9%
12.9%
Company 2
950
12.3%
25.2%
Company 3
900
11.6%
36.8%
Company 4
850
11.0%
47.7%
Company 5
800
10.3%
58.1%
Company 6
750
9.7%
67.7%
Company 7
700
9.0%
76.8%
Company 8
650
8.4%
85.2%
Company 9
600
7.7%
92.9%
Company 10
550
7.1%
100.0%
Total
7,750
75% of total
5,813
EDIT:
My initial thought was to use percentile/quartile function, however that is not giving me the expected results.
I have been trying to use a combination of percentrank, sort, sum and aggregate - but cannot figure out how to combine them, to get the result I need.
In the example I want to include Companies 1 through 6, as that summarize to 5250, hence the smallest number to include is 750. If I add Company 7 I get above the 5813 (which is where 75% is).
VBA bubble sort - no changes to sheet.
Option Explicit
Sub calc75()
Const PCENT = 0.75
Dim rng, ar, ix, x As Long, z As Long, cutoff As Double
Dim n As Long, i As Long, a As Long, b As Long
Dim t As Double, msg As String, prev As Long, bFlag As Boolean
' company and amount
Set rng = Sheet1.Range("A2:B11")
ar = rng.Value2
n = UBound(ar)
' calc cutoff
ReDim ix(1 To n)
For i = 1 To n
ix(i) = i
cutoff = cutoff + ar(i, 2) * PCENT
Next
' bubble sort
For a = 1 To n - 1
For b = a + 1 To n
' compare col B
If ar(ix(b), 2) > ar(ix(a), 2) Then
z = ix(a)
ix(a) = ix(b)
ix(b) = z
End If
Next
Next
' result
x = 1
For i = 1 To n
t = t + ar(ix(i), 2)
If t > cutoff And Not bFlag Then
msg = msg & vbLf & String(30, "-")
bFlag = True
If i > 1 Then x = i - 1
End If
msg = msg & vbLf & i & ") " & ar(ix(i), 1) _
& Format(ar(ix(i), 2), " 0") _
& Format(t, " 0")
Next
MsgBox msg, vbInformation, ar(x, 1) & " Cutoff=" & cutoff
End Sub
So, set this up simply as I suggested.
You can add or change the constraints as you wish to get the results you need - I chose Binary to start but you could limit to integer and to 1, 2 or 3 for example.
I included the roundup() I used as well as the sumproduct.
I used Binary as that gives a clear indication of the ones chosen, integer values will also do the same of course.
Smallest Value of a Running Total...
=LET(Data,B2:B11,Ratio,0.75,
Sorted,SORT(Data,,-1),MaxSum,SUM(Sorted)*Ratio,
Scanned,SCAN(0,Sorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
srIndex,XMATCH(0,Scanned)-1,
Result,INDEX(Sorted,srIndex),Result)
G2: =SORT(B2:B11,,-1)
H2: =SUM(B2:B11)*0.75
I2: =SCAN(0,G2#,LAMBDA(a,b,IF((a+b)<$H$2,a+b,0)))
J2: =XMATCH(0,I2#)
K2: =INDEX(G2#,XMATCH(0,I2#)-1)
The issue that presents itself is that there could be duplicates in the Amount column when it wouldn't be possible to determine which of them is the correct result.
If the company names are unique, an accurate way would be to return the company name.
=LET(rData,A2:A11,lData,B2:B11,Ratio,0.75,
Data,HSTACK(rData,lData),Sorted,SORT(Data,2,-1),
lSorted,TAKE(Sorted,,-1),MaxSum,SUM(lSorted)*Ratio,
Scanned,SCAN(0,lSorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
rSorted,TAKE(Sorted,,1),rIndex,XMATCH(0,Scanned)-1,
Result,INDEX(rSorted,rIndex),Result)
Note that you can define a name, e.g. GetCutOffCompany with the following part of the LAMBDA version of the formula:
=LAMBDA(rData,lData,Ratio,LET(
Data,HSTACK(rData,lData),Sorted,SORT(Data,2,-1),
lSorted,TAKE(Sorted,,-1),MaxSum,SUM(lSorted)*Ratio,
Scanned,SCAN(0,lSorted,LAMBDA(a,b,IF((a+b)<=MaxSum,a+b,0))),
rSorted,TAKE(Sorted,,1),rIndex,XMATCH(0,Scanned)-1,
Result,INDEX(rSorted,rIndex),Result))
Then you can use the name like any other Excel function anywhere in the workbook e.g.:
=GetCutOffCompany(A2:A11,B2:B11,0.75)

Combine work days and calendar days for a calculator

Im trying to create a calculator for detention of containers.
Each provider has different rules that have a breakdown between work days and calendar days.
for example:
the first 5 working days (excl Saturday and Sunday) are free of cost
After that the next 3 calendar days are at a cost of 135
After the above, the next 5 calendar days are at a cost of 160
After that 180 onward.
is this possible to do in excel? My idea is to have a difference between 2 dates: date of arrival versus date of return. and based on the 4 rules below use "IF" to give me a cost.
what would be a more efficient way to do this?
HardCoded option:
With Dynamic array formula SEQUENCE()
=SUM(IF(SEQUENCE(B1-A1+1,,A1)<WORKDAY(A1,5),0,IF(SEQUENCE(B1-A1+1,,A1)<WORKDAY(A1,5)+3,135,IF(SEQUENCE(B1-A1+1,,A1)<WORKDAY(A1,5)+8,160,180))))
Older version:
=SUM(IF(ROW(INDEX($ZZ:$ZZ,A1):INDEX($ZZ:$ZZ,B1))<WORKDAY(A1,5),0,IF(ROW(INDEX($ZZ:$ZZ,A1):INDEX($ZZ:$ZZ,B1))<WORKDAY(A1,5)+3,135,IF(ROW(INDEX($ZZ:$ZZ,A1):INDEX($ZZ:$ZZ,B1))<WORKDAY(A1,5)+8,160,180))))
As an array formula, using Ctrl-Shift-Enter to confirm instead of Enter when exiting edit mode.
Using a lookup table.
Put 0 in the first cell in the lookup table. The second cell would get the formula =WORKDAY(A1,5) the next below: =F2+3 and the last =F3+5 and put the corresponding values:
Then use SUMPRODUCT and LOOKUP:
=SUMPRODUCT(LOOKUP(SEQUENCE(B1-A1+1,,A1),F1:F4,G1:G4))
older version:
=SUMPRODUCT(LOOKUP(ROW(INDEX($ZZ:$ZZ,A1):INDEX($ZZ:$ZZ,B1)),F1:F4,G1:G4))
Below is a VBA function that accepts three arguments - the start date, the end date, and the name of the carrier, and returns a cost. Only costing for one carrier is included, but it can be expanded for other carriers.
Function fContainerCost(dtmStart As Date, dtmEnd As Date, strCarrier As String) As Currency
Dim lngDays As Long
Select Case strCarrier
Case "CarrierA"
dtmStart = WorksheetFunction.WorkDay(dtmStart, 5)
If dtmStart > dtmEnd Then
fContainerCost = 0
Else
lngDays = DateDiff("d", dtmStart, dtmEnd) + 1 ' need to get the actual days, so get the difference in dates and add 1.
If lngDays <= 3 Then
fContainerCost = fContainerCost + (135 * lngDays)
Else
fContainerCost = fContainerCost + (135 * 3)
lngDays = lngDays - 3
If lngDays <= 5 Then
fContainerCost = fContainerCost + (160 * lngDays)
Else
fContainerCost = fContainerCost + (160 * 5)
lngDays = lngDays - 5
fContainerCost = fContainerCost + (180 * lngDays)
End If
End If
End If
Case "CarrierB"
End Select
End Function
To use it, just treat it as a regular Excel function:
=fContainerCost(A1,B1,C1)
Regards,

Why does DateDiff return a date and not the number of minutes?

I need to find how many minutes exist between two string.
h1 = TimeValue("06:00:00")
h2 = TimeValue("22:00:00")
res = DateDiff("n", h1, h2)
However, res = 17/08/1902 whereas the expected result is 960.
Sub calcul(hours As Variant, Optional n As Integer = 0)
i = 3
Do While (Cells(i, 0) <> "")
Dim res As Date
Dim h2 As Date
Dim h1 As Date
Dim h As Integer
If (n = 0) Then
h = 0
Else
h = Cells(i, 7).Value - 1
End If
h1 = TimeValue(hours(h)("h1"))
h2 = TimeValue(hours(h)("h2"))
res = DateDiff("n", h1, h2)
...
The problem here is how you you've defined res.
Dates and time values are numbers. Even if you see it as 30/09/2019 or 12:00:00, actually, for Excel, both cases are numbers.
First date Excel can recognize properly is 01/01/1900 which integer numeric value is 1. Number 2 would be 02/01/1900 and so on. Actually, today is 43738.
For times is the same, but the decimal parts are the hours, minutes and second. 0,5 means 12:00:00. So, actually, 43738,5 means 30/09/2019 12:00:00.
Anyways, in your case, you are obtaining time difference between 2 times in minutes. The result is 960, but you are asigning this value to a date type, so 960 is getting converted to 17/08/1902.
Dim h1 As Date
Dim h2 As Date
Dim res As Single
h1 = TimeValue("06:00:00")
h2 = TimeValue("22:00:00")
res = DateDiff("n", h1, h2)
Debug.Print res
The code above will return 960 properly. Adapt it to your needs.
UPDATE: Because DateDiff returns a Long, defining res as Single is not worth it at all. I did it because working with times, in many cases, needs decimals, but if you are using just DateDiff, then you can perfectly do res as Long or res as Integer.
Note the difference between DateDiff and a normal substraction with a simple code:
Dim time1 As Date
Dim time2 As Date
Dim res1 As Integer
Dim res2 As Single 'or double if you wish
time1 = "06:00:00"
time2 = "06:30:30"
'time difference between these 2 values are 30 minutes and 30 seconds (30,5 minutes in decimal)
res1 = DateDiff("n", time1, time2)
res2 = (time2 - time1) * 1440 '1440 is the number of minutes in a whole day
Debug.Print "With DateDiff:" & res1, "Normal: " & res2
The output of this code is:
With DateDiff:30 Normal: 30,5
Using DateDiff sometimes is not worth it. Depending on how accurate you need the result, DateDiff may compensate or not. I would suggest you to avoid it if you can (this is jut my opinion)
Hope this helps
UPDATE 2: About the code above, yes, a solution would be using DateDiff("s", time1, time2) / 60 to get the seconds transformed into minutes, but this value, because of decimals, should be assigned to a data type that allows it.

Get day number within calendar week for a specific date

I have a data set which includes dates.
I need to split this out by week number for reporting purposes.
What I have so far is:
startDate variable containing 03/01/2015 (populated from data in spreadsheet)
startDay = Day(startDate)
startMonth = Month(startDate)
startYear = Year(startDate)
startWeek = Application.WorksheetFunction.WeekNum(DateSerial(startYear, startMonth, startDay))
which gives me week 1 in startWeek
However I know need to know how far into week 1 the date is.
So for this example, as the date is the 3rd of January, it includes 3 days of week 1
Meaning the reporting I'm putting together will only report on 3 days (as opposed to the full week)
The only way I've figured to do this so far is to calculate which day of the year the date is and the use a MOD calculation (basically divide by 7 and the remainder is how far into the week it is)
dayNumber = DateDiff("d", DateSerial(startYear, 1, 1), DateSerial(startYear, startMonth, startDay)) + 1
dayOfWeek = dayNumber Mod 7
This does work, but I was wondering if there was a nicer solution than this.
You could use a loop to determine how many days before startDate the week number changed:
Public Sub FindDaysInWeekNo()
Dim startDate As Date
startDate = DateSerial(2015, 1, 3)
Dim startWeek As Integer
startWeek = Application.WorksheetFunction.WeekNum(startDate)
Dim i As Integer
Do While startWeek = Application.WorksheetFunction.WeekNum(DateAdd("d", -i, startDate))
i = i + 1
Loop
Debug.Print i '= 3rd day in this week number
End Sub
The following table shows my comparison to the other suggested formulas and why I think that (refered to =WEEKNUM) my calculation is correct.
Note that if you assume 1st to 7th January will be week 1 (days 1 to 7) you cannot use the WeekNum function because this will give you a different result (see table above and note that the first week has only 6 days according to the WeekNum function). Also you cannot name this week number (as what everybody calls week number is defined as https://en.wikipedia.org/wiki/Week#Week_numbering).
Instead you will need to use …
Public Function AlternativeWeekNum(startDate As Date) As Integer
AlternativeWeekNum = WorksheetFunction.Days(startDate, DateSerial(Year(startDate), 1, 1)) \ 7 + 1 'note that this no normal division but a integer division and uses a backslash instead
End Function
to calculate the week number your alternative way, and …
Public Function AlternativeWeekNumDay(startDate As Date) As Integer
AlternativeWeekNumDay = WorksheetFunction.Days(startDate, DateSerial(Year(startDate), 1, 1)) Mod 7 + 1
End Function
to calculate the day in the alternative week.
You can use the Weekday() function for this:
=WEEKDAY(B4;2)
The second parameter mentions how you want your days to be counted (starting from Sunday or Monday, counting starting from 0 or from 1, ...).
dayOfWeek = (8 + Weekday(startDate) - Weekday(DateSerial(startYear, 1, 1))) mod 7
Just take the positive mod 7 of the difference between the current Day-Of-Week and the Day-Of-Week for the 1st January of whatever the year is

Week number to Month number

I have a date with this format : 14w01 (year : 2014 week number : 1)
I want to convert this date in month like this : 14m01
Is there a function which converts a week number in a month number ?
Maybe something like this (in vba, not in formula) :
Format(weekNumber, "mm")
Thank you
It depends on how the weeks are defined. One way is to say that the first day of week#1 of a year is 1 January of that year. For this definition, a typical UDF is:
Public Function MonthFromDt(s As String) As Integer
Dim yr As Integer, wk As Integer, d As Date
ary = Split(s, "w")
yr = CInt(ary(0)) + 2000
wk = ary(1)
MonthFromDt = Month(DateSerial(yr, 1, 1) + 7 * (wk - 1))
End Function
There are other definitions of week number.
The DateFormat function is quiet comfortable, however the DateValue function, which parses a date, won't probably support your week format.
I suggest a trick with DateAdd, as DateAdd can handle weeks.
First split your date in year and week number:
Dim parts
parts = Split("2014w33", "w")
Dim year
Dim week
year = CInt(parts(0))
week = CInt(parts(1))
Then, add both to a "zero-date" to add up to the final date. Note that if you give "0" as year for DateAdd, VBA compiler interprets 2000.
dim DateResult
DateResult = dateAdd("yyyy", (year - 2000), DateValue("Jan 1, 0"))
Debug.Print dateResult
DateResult = dateAdd("ww", week, dateResult)
Debug.Print dateResult
Then show the result reformatted:
Debug.Print Format(DateResult, "yyyy\mm")
This prints on my side:
01.01.2014
20.08.2014
2014m08
August 2014, there is week 33 if I look up in the calendar. Seems correct.
I found a way to do it without VBA (and only using Formulas). This assumes A1 contains the "14w01" format
=LEFT(A1,2)&"m"&TEXT(MONTH(DATE(20&LEFT(A1,2),1,1)+(RIGHT(A1,2)*7)),"00")
Heres a breakdown of what the code does..
LEFT(A1,2) returns "14" (year)
MONTH(DATE(20&LEFT(A1,2),1,1)+(RIGHT(A1,2)*7)) converts the week # to the month # and it takes in the year 20&LEFT(A1,2) as well as week # RIGHT(A1,2)
TEXT(...,"00") pads the month # with a 0 if necessary (i.e. 3 becomes 03)
Then we just combine everything together to get "14m01"

Resources