Macro or other code for deteming Months, Years, Quarter based on d

[Sue]

I have a very specific problem related to dates. In order to do what I want
each cell is requiring different formulas. If there is a way to do what I
need to using a macro or VBA Code that would make things much easier.

I have a spreadsheet with 13 columns the last three (K, L and M) being
Months, Years and Quarter
I have a series of dates that I have to work with that look like this in
columns G, H, I and J
StartDate Adj_Start_Date Current_Date Term_Date
5/31/2000 5/31/2000
5/31/2000 4/1/2007 11/10/2004
5/31/2000 4/1/2007 1/31/2006
5/31/2000 4/1/2007 3/3/2007
5/31/2000 4/1/2007
5/29/2000 9/18/2004 8/31/2004
5/29/2000 9/18/2004
5/31/2000 5/31/2000
5/31/2000 1/1/2003 5/31/2001
5/31/2000 1/12/2006 1/3/2000
5/31/2000 1/12/2006 8/1/2003
5/31/2000 1/12/2006 10/1/2004
5/31/2000 1/12/2006
5/31/2000 5/31/2000
5/31/2000 5/31/2000
5/31/2000 5/31/2000
5/29/2000 5/29/2000 6/30/2007 6/30/2007

What I would like to do is calculate the months, years and quarter for each
row in order to determine how long each person has been on the account.
Forinstance if both the start date and adj_start_Date are populated (and are
the same) and not other date is populated I would calculate the months, years
and quarter based on the start date and today's date. As you can see I have
term_dates that do not match the adj_start_date. In this case I would have
to calculate the months, years and quarter based on the TermDate and the
StartDate if no current date is populated.

If the current date is populated the dates calcutions would be between the
adj_start date and the currentdate.

I'm having a problem performing these using functions. If there is code
that will help I'd be appreciative.

Thank you in advance for your help.
Regards,

 

[Joel]

I'm not sure I got exactly what you need. Idid it with formulas. I caculate
months as (12 * (end year - start year) + (end month - start month). I
caculate years as end year - start year. I calculate Quarter as int(months/3)

Months caculation
=IF(ISBLANK($I2),IF(ISBLANK($J2),12*(YEAR(TODAY())-YEAR($G2))+(MONTH(TODAY())-MONTH($G2)),12*(YEAR($J2)-YEAR($G2))+(MONTH($J2)-MONTH($G2))),12*(YEAR($I2)-YEAR($H2))+(MONTH($I2)-MONTH($H2)))

Years caculation
=IF(ISBLANK($I2),IF(ISBLANK($J2),YEAR(TODAY())-YEAR($G2),YEAR($J2)-YEAR($G2)),YEAR($I2)-YEAR($H2))

Quarters
=INT(K2/3)

 

[Bill Renaud]

Here is a suggestion to help you get started writing UDFs (user-defined
functions). They really aren't hard at all, once you figure out some
basics. Start up the Visual Basic editor (Alt+F11 or use the menu), then
Insert|Module (standard code module, not a Class Module). Paste the
following code into the editor window, then Debug|Compile VBA Project.
Close the VBA editor window. You can now use your UDF just like any other
built-in Excel function. After typing the "=" sign in the formula bar,
select "User Defined" at the bottom of the Function category list box, then
select your UDF in the Function name list box. Fill in the arguments as
usual.

You won't need to declare the types of the arguments. They will be variants
by default. Also, the return value of the function will be variant by
default, since it is not declared after the closing right paren after the
arguments.

To test to see if an input argument is an empty cell, use the IsEmpty
function. Notice inside each If statement that I put an Exit Function
statement after the calculation for that case. This will prevent your code
from recalculating the function again (wrongly) in the lines of code that
follow below. Just make sure that you do the calculation before any Exit
Function statement. Be sure to cover all cases, or return an error value
(see several paragraphs below).

You will probably have 3 functions (one each for "AccountMonths",
"AccountYears", and "AccountQuarters") when you get done. You might be able
to factor out a lot of the common logic for each of these. I used
"AccountMonths" as the name of the example function below so as not to
confuse it with Months, which might be a worksheet function or something.

NOTE: You will have to define what your function is, as it is not really
clear to others in the newsgroup from your description. I simply subtracted
the 2 values that you indicated in your text, but I know this will have to
be divided by 12, 4, dates rounded to ends of months, etc. or something
else. Use the following statement format example to call worksheet
functions from inside your UDF:

YourVariable = Application.WorksheetFunction.Max(arg1,arg2)

If you want to return an error value, then use the following statement
(there are several values for the CVErr argument that you can use):

AccountMonths=CVErr(xlErrValue)

Post additional info if you need more help.

'----------------------------------------------------------------------
Public Function AccountMonths(StartDate, AdjStartDate, _
CurrentDate, TermDate)

Dim dtToday As Date

'Get current system date once, for consistent processing.
dtToday = Date

'If both StartDate and AdjStartDate are populated (and are the same)
'and no other date is populated, then calculate the months, years
'and quarter based on StartDate and today's date.
If Not IsEmpty(StartDate) _
And Not IsEmpty(AdjStartDate) _
And StartDate = AdjStartDate _
And IsEmpty(CurrentDate) _
And IsEmpty(TermDate) _
Then
'Change as needed.
AccountMonths = dtToday - StartDate
Exit Function
End If

'Calculate months, years and quarter based on the TermDate
'and the StartDate, if no current date is populated.
If Not IsEmpty(AdjStartDate) _
And IsEmpty(CurrentDate) _
And Not IsEmpty(TermDate) _
Then
'Change as needed.
AccountMonths = TermDate - StartDate
Exit Function
End If

'If CurrentDate is populated, then calculate the time
'between the AdjStartDate and CurrentDate.
If Not IsEmpty(CurrentDate) _
Then
'Change as needed.
AccountMonths = CurrentDate - AdjStartDate
Exit Function
End If

'More cases below as needed.
'To return an error, do the following:
'See the different values of arguments in the
'XlCVError class in the Object Browser.
AccountMonths = CVErr(xlErrValue)

End Function

 

[Sue]

Joel,

thank you. I'll give this a try (my formula efforts weren't working) and
let you know how I made out.

 

[Sue]

Bill,

Thank You. I have other code that I have modified in the VB Editor but I
have a problem writing it myself. Time to find a class on this. I'll give
this a try and let you know how it worked for me.

Thanks