Struggling with an excel user defined function to calculate a total production generated by different bacteria patches starting at different times but following the same growth pattern; I have tried to simplify my problem below:
Example tables
PROFILE table: I have a 2 columns x 6 rows Table (A2:B9) showing a bacteria production per week depending on the age of the colony (column A gives the period, column B the production: in the first 3 weeks the bacteria produce 1/week in the next 3 weeks they produce 2 per week etc); I call this table my production PROFILE, this may vary depending on the type of bacteria I have (and other environmental parameters). I have decided in this particular example, and to keep it simple to show the population growth per period in a table, the growth values could of course be generated by a function (linear, exponential, with a decay factor etc) I guess that if I can crack the problem, adding a level of complexity with a growth function shouldn't be an issue.
RESULT table: I then have a 3 columns 20 rows table (A14:C33) which shows over a 20 week period (my 20 rows, numbered 1 to 20 in column A) when I start some bacteria cultures (1 in week 3, 2 in week 6 etc), I call it my RESULT table
I'd like to show in column C of the RESULT the total production of the colonies for each week.
I tried creating a PROD(week, PROFILE) function where I defined both "week" and "PROFILE" as variants and where "PROFILE" actually relates to my PROFILE table. It works fine when "week" is an individual cells (ie PROD(A18,PROFILE)=2) but doesn't work with ranges (PROD(A14:A33,PROFILE) returns an error message)
Function PROD(period As Variant, profile As Variant) As Variant
r = profile.Rows.Count
If profile(1, 1) >= period Then
PROD = profile(1, 2)
Else
For i = 2 To r
If profile(i, 1) >= period Then
If profile(i - 1, 1) < period Then
PROD = profile(i, 2)
End If
End If
Next i
End If
PROD = Application.Round(PROD, 2)
End Function
is there an elegant solution to populate column C of RESULT?
I did a similar thing on a previous assignment (finance) combining a sumproduct with the excel pmt function ( -pmt(rate, nper, pv,..) where pv was a range) and this did work, I managed to get a nice calculation of my total depreciation cost on a given period when I could have had items purchased in different quantities and at variable prices over the previous periods. the formula I used back then, shown on the attached Example of DepTable&Formula is
SUMPRODUCT(-PMT($C$7,$C6,$C$3:$V$3),N($C$4:$V$4<=C$2),N(($C$4:$V$4+$C6)>C$2))
I tried to replicate it here with a custom function with my bacteria population but I am really stuck.
I can't quite imagine what your profile table might look like nor, in fact, what exactly you want to extract. Perhaps my attempt below gives you some ideas. Please study it and let me know where it needs improvement.
Function PROD(period As Variant, profile As Variant) As Variant
Dim Fun As Variant
Dim R As Long
R = 1 ' should this always be 1?
Do
Fun = Fun + profile(R, 2).Value
R = R + 1
If R > profile.Rows.Count Then Exit Do
Loop While profile(R, 1) >= period
PROD = Application.Round(Fun, 2)
End Function
I wouldn't use this as a UDF, however. Instead, I would modify it slightly to write directly into the C column. Let the function be called from the Worksheet_Change event, linked to the profile table, or perhaps both tables, so that the data update automatically whenever there is a change. With the UDF updating will take place only when the sheet is recalculated, and I found that not to be easily controlled.
If this isn't what you want then it should be a lot nearer to it than what I did this morning. Take a look.
Function PROD(Period As Range) As Single
Dim Fun As Single
Dim Periods As Integer
Dim Weeks As Integer
Dim A As Integer
Dim R As Long
Periods = Period.Cells.Count
For A = 1 To Periods
Weeks = CInt(Period.Cells(A).Value)
With Range("Profile")
For R = 1 To (.Rows.Count - 1)
If .Cells(R, 1).Value >= Weeks Then Exit For
Next R
Fun = Fun + .Cells(R, 2).Value
End With
Next A
PROD = Application.Round(Fun / Periods, 2)
End Function
Call this function with =Prod(A14:A20) or =Prod(A14:A14) or = Prod(A14)
It will extract one result from the Profile table for each of the specified weeks. A14:A20 will have 7 results, and so would A16:A22. The function draws an average. So, with 7 results, these seven are added up and divided by 7. Perhaps this isn't yet what you want, but you might be able to manipulate the result of the function to meet your requirements.
Related
First, let me say this. I am new to using access and VBA functions.
My overall goal is to add functionality to my database as described below:
This database consists of patients enrolled in a Clinical Trial, these patients have a unique identifier in the format GKID-XXXXX where the XXXXX is an alphanumeric base 35 counting system.
Eg. the numbering goes like this GKID-00000, GKID-00001, GKID-00002, GKID-00003,... , GKID-0000Z. Base 35 because it exclude the letter O.
Previously, we would generate these IDs and type them in manually. However, in the future, we would like these to be automatically created when a new patient is added to the database. However,
we want to retain the ability to add IDs in manually without changing any existing IDs, delete records without changing the assigned IDs, and the IDs created cannot be already used.
I have tried many things and the naive strategy I have made progress with is as follows.
Take the existing "Working Table" that contains all of the existing IDs in a field. This field would be left blank for newly added patients who we want to automatically generate an ID for.
Using this working table, create a new table with a query. This would be the table with the IDs. It would exactly match the existing table except the ID column from the first table would be replaced with one that generates IDs with a custom VBA function. The function takes the Working Table ID field in as a variable and returns the generated ID. If the field is occupied, it simply returns the ID, if not, it generates a new one. Below is the progress I have made in accomplishing this.
Option Compare Database
Function GavFun2(EIID As String) As String
strAlphabet = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
These are the characters in the base 35 counting system.
N = Mid(EIID, 6, 5)
This simply extracts the 5 alphanumeric digits of the Working Table ID
Dec = (InStr(strAlphabet, Mid(N, 5, 1)) - 1) * 35 ^ 0 + (InStr(strAlphabet, Mid(N, 4, 1)) - 1) * 35 ^ 1 + (InStr(strAlphabet, Mid(N, 3, 1)) - 1) * 35 ^ 2 + (InStr(strAlphabet, Mid(N, 2, 1)) - 1) * 35 ^ 3 + (InStr(strAlphabet, Mid(N, 1, 1)) - 1) * 35 ^ 4
This Decodes this back into a base 10 system
GavFun2 = GavFun(CInt(Dec))
This converts the number back into the base 35 system and returns the ID in its full string form (function included below).
If EIID = Empty Then
End If
End Function
This if statement is where I am running into a wall. I want to fund the maximum value of Cint(Dec), then simply return GavFun2 = GavFun(Max(Cint(Dec))+1). I feel like this would be a good start, but there would be a number of problems if I was able to even get this to work.
A. If there ware multiple blank records, they would all have the ID (maybe replace with a for loop that runs through each blank consecutively and start the counter at Max(Cint(Dec))+1, but I don’t know how to do this.)
B. If I were to add a new patient with a custom ID (or delete one), this could potentially change all of the generated IDs.
Any thoughts on my general approach or advice on how to proceed would be very much appreciated. Thank you so much for your help.
Option Compare Database
Function GavFun(IDD As Integer) As String
strAlphabet = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
If IDD = 0 Then
GavFun = "0"
Exit Function
End I
GavFun = vbNullString
Do While IDD <> 0
GavFun = Mid(strAlphabet, IDD Mod 35 + 1, 1) & GavFun
IDD = IDD \ 35
Loop
ZZ = Array("0", "00", "000", "0000", "00000")
L = Len(CStr(GavFun))
MM = ZZ(4 - L)
GavFun = "GKID-" & MM & GavFun
End Function
Ok, the way to approach this?
Well we often need all kinds of speical numbering systems. For invoice, PO numbers, maybe a badge number, employee numbers etc. Now in these cases? Such numbers have VERY little to do with relational databases. I mean becuase you might not yet have some silly invoice number, your whole software package comes crashing down?
So, such external numbers? They don't have anything to do with how you build your relationships between tables. For that you use the PK (ID - autonumber), and then the FK (forighen key) in the child table. things like City, invoice number, name etc? That's just data you store - ZERO to do with relationships.
Ok, so now that we got above out of the way.
First up:
You don't want to hit the whole database to find some max number or some such. While this might work for single user, it not really a good idea.
So, for badge numbers, incrementing product numbers, invoice numbers, and hey, maybe even a clincial trial number?
You create a table with a SINGLE row in that table. That way you can then even say go and change/set what the starting number/point is to be. So yes, you ARE on the right tack - you want to build your own custom numbering system, and then use that for a column in that table (as I stated, this is just a number, or value - not different then city, first name, or say some invoice number - NOTHING to do with the PK, and NOTHING to do with relatonal database stuff.
Ok, so, now we need some things here.
First, we need that table that keeps track of this number for us.
Next, we need a routine to get this "value" and then increment the value for the next time.
And then we need to setup a nice way to get and then put/shove/have that number auto matic be setup and entered into that form for us, and of course make sure if that record already has a number, we don't over write it.
Thus we can break this problem down into separate parts.
First, create our increment number handy dandy maintains table like this:
So that's our table. Nice part is we can edit the starting number, and even the prefix - so if you do another run/study, we can easy start a new number set. we DON'T care about the existing data - build a number system - it just runs and works like a good water pump.
Ok, next we need our routine to go please get me the next number.
Our code can work like this:
Public Function GetNextPID() As String
Const Alpha = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
Const MaxDigts = 4
Const Base = 35
Dim OnePart As Long
Dim OneDigit As Long
Dim rstNext As DAO.Recordset
Dim OurNum As Long
Dim i As Integer
Dim strResult As String
Dim strPrefix As String
Set rstNext = CurrentDb.OpenRecordset("NextPatientNum")
OurNum = rstNext!NextNumber
strPrefix = rstNext!Prefix
rstNext.Edit
rstNext!NextNumber = OurNum + 1
rstNext.Update
rstNext.Close
' convert our number to base
Dim s As String
For i = MaxDigts - 1 To 0 Step -1
OnePart = Int(OurNum / (Base ^ i))
s = Mid(Alpha, OnePart + 1, 1)
strResult = strResult & s
OurNum = OurNum - Int(OnePart * (Base ^ i))
Next i
GetNextPID = strPrefix & "-" & strResult
End Function
So, place the above code function in a standard code module (not in a form).
Now, hit ctrl-g, and we can test it like this from the debug (immediate window)
? GetNextPID
Output: GKID-0007
So, now you can just edit that "one row" maintains table to start at whatever number you like or feel like. once you set that number, then each time you call that routine, it will go get you the next number based on our new number system.
Now, all we have to do is in that form? Well, we could just write code to check if the text box/field is not yet set, but there is ALSO a event on the form that fires ONLY when you add/insert that record in the form. It not 100% clear when/how your form works, but we can do something like this:
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.PatientNum = GetNextPID
End Sub
(of course you don't type in the event stub part).
Note close: if the record is blank - not dirty, then nothing happens. You can even close the form. However, the instant you start typing anything into that form with a new record, then like magic that code will run, and shove in the new number into that text box on the form, the new patient number will appear.
As noted, we can even go edit that maintains table, give it a new prefix and new number for a whole new study.
Edit: feel free to use your existing logic - either way, don't try and hit/use the database table with existing data to get/make/generate the new ID - use your function idea, but it will simple automatic return + generate the next new number you need upon calling that function.
I am a newbie to using VBA to program functions in Excel (just started this morning actually). Here is my problem including my almost but non-working solution.
Problem outline:
I have 2 columns of data, a userID and a Date column. I want to create a function that returns the maximum date (latest) for a userID. A userID may appear once, or many times (number varies from user to user, but doesn't exceed 20).
Now to make this problem a easier for my little brain, I pre-sort the userIDs to appear one after another, and then created a third column to mark the first instance of a userID (not necessarily the one with the earliest/latest date) using a simple excel If statement: If its the first instance it is the userID, else it is empty.
Then I created a function that takes in a range of cells (userIDs), and a single other value (the third column cell containing a single value of userID)
A typical excel worksheet will look like this:
userID Date First Instance
1 3/3/12 1
1 3/2/11
1 2/3/14
2 2
2 3/4/15
2
2 5/6/15
3 5/5/16 3
4 4/4/14 4
4
4 6/7/08
...
I wrote the function below, which takes in userID as the iRange (I select more than 20 so that for other users which may have 20 instances of userID are also included), and idCell as the single identifier of the first instance of userId.
The logic behind the code is:
Loop through iRange and compare it to idCell
If it's equal, check that the next cell (next to the element from iRange is a date) and if it is
Check whether it is larger than the maxDate, store it if true
At the end I return maxDate
The result:
I get a number back, but it isn't a date and I don't think it has any bearing on a date.
Function returnDate2(iRange As Range, idCell As Range) As Date
Dim elem As Variant
Dim i As Long
Dim maxDate As Date
For Each elem In iRange
If elem = idCell Then
If IsDate(elem.Offset(0, 1)) Then
If elem.Offset(0, 1) > maxDate Then
maxDate = DateValue(elem.Offset(0, 1))
End If
returnDate2 = maxDate
End If
End If
Next elem
End Function
Thanks in advance!
I'm a little bit newbie about excel-vba but I am trying to construct a function that gives me the dates of coupon payments for a bond.
Giving a simple example I have this two bonds:
Nominal value: 100;300
Coupon rate: 0,06 ; 0,05
CPN_Freq:
4;
2
Months:
3; 6
Settlement:
01-11-2001;
01-11-2001
Maturity:
15-12-2003;
15-05-2005
Basis: 0;1
And what I want is the date of the coupon payments for each bond, for the first it will be:
15-12-2003 15-09-2003 15-06-2003 15-03-2003 15-12-2002 15-09-2002 15-06-2002 15-03-2002 15-12-2001 01-11-2001 (each in a cell)
I made this code but is not working.
Function CouponDate( Maturity As Date, Settlement As Date, Months
As Date)
For i= Maturity - Months
If Maturity - Months > Settlement
CouponDate = i - Months
Else
CouponDate= Settlement
End if
End Function
Could u give me a help please? Thanks :)
You cannot use a function because you have multiple return values.
You can use a Sub (without return value) that then writes the return values directly in the desired cells. That's what the additional parameter FirstOutputCell is for: it defines the first cell that should be written.
Public Sub CouponDate(Maturity As Date, Settlement As Date, Months As Long, ByRef FirstOutputCell As Range)
Dim i As Long
Dim CouponDate As Date
i = 0
Do
CouponDate = DateAdd("m", -i * Months, Maturity)
If CouponDate <= Settlement Then
CouponDate = Settlement
End If
FirstOutputCell.Offset(i, 0) = CouponDate
i = i + 1
Loop While CouponDate > Settlement
End Sub
If you have Maturity, Settlement and Months in the cells B1, B2 and B3 respectively a call of CouponDate Range("B1"), Range("B2"), Range("B3"), Range("B4") would fill the cells B4 through B7 with the coupon dates (if you want the output in columns not rows simple switch the parameters of the Offset() function).
Of course you can also call the function directly specifying the parameters: CouponDate #5/30/2003#, #11/1/2001#, 3, Range("B4")
Make sure the first two parameters are of type Date. Passing the string "15-12-2003" might work, depending on the locale that is set for your OS. Better is to either use an Excel cell formatted as date or - as shown above - date literals of the form #m/d/yyyy#.
The above code will work correctly even for maturity dates at the last day of month. If you want to change the code to be more flexible so that you can specify the days between two coupons you would also have to take into account the appropriate day count convention, making this a whole lot more complicated.
In my excel sheet I have an varying number of dates in column A with associated totals for each date in column B. The dates are somewhat random but I want to find the sum of the associated totals per week. I'm new to vba and I'm having a bit of trouble figuring out how to calculate the totals per week.
The psudo code for what I'm thinking is:
buttonClicked()
Dim sum As Integer, tempDate As Date, current As Date, i As Integer, j As Integer, match As Boolean
sum = 0
tempDate = Range("A1").Value
current = tempDate
For i = 1 To Rows.Count
for j = 0 to 7
tempDate = addDate(d, i, tempDate)
If cell(i,1).Value = tempDate Then sum = sum + cell(i, 2).Value
match = true
Break
End If
Next j
If match = true Then tempDate = current
Else
`next open space in column D is current
current = tempDate
`next open space in column E is sum
sum = 0
Next i
end
Please let me know if there's any better way to solve this problem other than iterating through the entire list and counting 7 days ahead. I should note that A1 is already assumed to be a sunday and I'm not sure how the commented out lines should be implemented. I would be very grateful for any advice at all.
In other column assign the corresponding Year.WeekNumber to each row using the following formula:
=CONCATENATE(YEAR(A1),".",TEXT(WEEKNUM(A1),"00"))
The totals per Year.Week can be obtained using a SUMIF formula or via a PivotTable. The PivotTable can be auto resize if you use a Dynamic Range as DataSource
If you are looking for a series of 7 row sums from column B, then this formula using native worksheet functions should do.
=SUM(INDEX(B:B, (ROW(1:1)-1)*7+1):INDEX(B:B, (ROW(1:1)-1)*7+7))
Fill down to catch successive week periods.
If you can supply a starting date (e.g. =MIN(A:A)) and add 7 to it in successive rows, then the weekly starting date could be a reference point for a SUMIFS function. In E9 as,
=SUMIFS(B:B,A:A, ">="&D9,A:A, "<"&D9+7)
Fill down as necessary.
If a VBA solution is necessary, that logic can be brought into a VBA sub or function.
Back Story
At my job we use a desk calendar to keep track of a multitude of random details that occur: Everyone's daily hours, what type and how many reports were sent, etc. To help us in filling out a few forms my boss decided he wanted to create a spreadsheet for the month and keep it as up-to-date as possible day by day. He went on vacation before this month started, so I've been taking over his duties. Something I noticed is that he hardwired the calculations for the totals (everyone's total hours, total reports sent, etc), so that when I changed the dates from January to February we had some left over ones that lead into March. I deleted them and then the formulas all threw #REF! errors because of it.
How the data is set up is simple:
AB 2.50
CD 3.50
EF 8.00
...ETC...
With the AB,CD,EF being in one column, and the values being in the adjacent column.
The Question
I tried to get this to work, with no luck, so I'm thinking it might be impossible but I thought I'd ask a group of people who know more about the subject than I do: in a function I made I have it accept a string parameter to search for, if it finds it, it moves to the adjacent cell and adds that value to the running total. It then returns that number at the end, so a call to this function would resemble
=getTotals("AB") ' this would display whatever the total for AB is
But when I tried this all I got was a #VALUE! error in the cell.
Is there any way I can get this to work the way I want it to, without the use of a full macro?
The Function
I got this function to work, how I wanted to
Function getTotal(rng As Range, search As String) As Double
Dim r As Range
getTotal = 0
For Each r In rng
If r.Value = search Then
getTotal = getTotal + r.Offset(0, 1).Value
End If
Next
End Function
Calling it like so: =getTotal(A1:D2, "AD")
SUMIF should get you what you need:
=SUMIF(A1:A10,"AB",B1:B10)
Assuming your 'AB' values are in column A, rows 1-10 and the number values are in column B, rows 1-10.
The first argument in SUMIF is the range to check, the second argument is the condition that must be met (search criteria), and the 3rd [optional] argument is the corresponding range from which to get the values to be summed.