code for formatting like custom cell formatting in excel

  • Thread starter Thread starter DawnTreader
  • Start date Start date
D

DawnTreader

Hello All

i am looking to be able to format information returned in a query according
to the users desires. i was thinking about how in excel i can create a custom
format according to the string that i create to format it.

does anyone know of somewhere that might have code that i can adapt, or a
way to create the same kind of functionallity?

for example i would like the user to be able to enter something like:

P_##_Y_##_M_##_D_T_##_H_##_M_##_S

and have it return this:

P 01 Y 01 M 01 D T 01 H 01 M 23 S

or enter this:

P_##Y_##M_##D_T_##H_##M_##S

and have it format the output as:

P 01Y 01M 01D T 01H 01M 23S

which in case you are curious is the output from the diff2date function in
Years, Months, Days, Hours, Minutes, Seconds. the P stands for Period, T
stands for Time.

i am trying to create a way to do this, but i am ending up with a lot of
variables. it would be nice if i could have one variable entered and then
somehow it looks at the variable and knows what to put in the output string
and where.

any and all help appreciated. :)
 
DawnTreader said:
i am looking to be able to format information returned in a query according
to the users desires. i was thinking about how in excel i can create a custom
format according to the string that i create to format it.

does anyone know of somewhere that might have code that i can adapt, or a
way to create the same kind of functionallity?

for example i would like the user to be able to enter something like:

P_##_Y_##_M_##_D_T_##_H_##_M_##_S

and have it return this:

P 01 Y 01 M 01 D T 01 H 01 M 23 S

or enter this:

P_##Y_##M_##D_T_##H_##M_##S

and have it format the output as:

P 01Y 01M 01D T 01H 01M 23S

which in case you are curious is the output from the diff2date function in
Years, Months, Days, Hours, Minutes, Seconds. the P stands for Period, T
stands for Time.

i am trying to create a way to do this, but i am ending up with a lot of
variables. it would be nice if i could have one variable entered and then
somehow it looks at the variable and knows what to put in the output string
and where.
Click to expand...


You did not provide sufficient information to get a specific
answer. Custom formats are the same in Excel and Access,
but because Excel displays data in sheets and Access
displays it table fields, query fields, form controls and
report controls there are quite a few different approaches
to using a user specified custom format.

Displaying a table or an updatable query in sheet view is
almost always a bad idea because less than expert users can
really make a mess of things. If users are allowed to edit
the displayed data, it is far better is to use a form with
validation code in the form's BeforeUpdate event. If users
are not allowed to edit the data, then a read-only form or a
report is the preferred way to display data.

With all that in mind, it is easy to stuff a custom format
string into a table and then use it by retrieving it and
poking it into a form or report text box's Format property.
I can suggest some code, but will need more information
about the mechanism you want to use to display the data, how
these formats are associated with individual users,
where/how users enter the format string and how many of
these formats each user can create.

OTOH, poking a custom format string into a table or query
field's Format property will modify the table/query's
design, which in general is something to be avoided.
 
whoops.

sorry.

here is the story so far: i am working on modifying the diff2date function
to fit what i need. i have a few different places that i want to be able to
output the information created by the diff2date function. one is in a list
box where the users will see how long a product has been out of commission. i
want to be able to use a string to format the results coming from the
diff2date function.

i had been working on formatting it by using optional boolean variables in
the function, but found that the more options i wanted the more i ended up
with a pain to manage the options. i thought it would be better if i created
the ability to use one string that told the function how to lay out the
results. i am already working on this idea, but was looking for a little help
on how to get the string to parse into the yes/no's that i needed to tell the
function to lay it out properly.

here is the code that i am using currently:
Public Function Diff2Dates(Interval, strY, strM, strD, strH, strN, strS As
String, Date1 As Date, Date2 As Date, _
Optional LargestIntervalOnly, Optional
ShowPlurals, Optional ShowSpaces, Optional ShowZero, _
Optional ShowNegInterval, Optional
ShowLeadingZero, Optional ShowPeriodTime, _
Optional ShowComma As Boolean = False) As Variant

'Author: Copyright 2001 Pacific Database Pty Limited Graham R Seach MCP
MVP (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593 This code is
freeware. Enjoy...
' (*) Amendments suggested by Douglas J. Steele MVP
' (*) Largest Interval Function, ShowSpaces, str?,
ShowNegInterval, ShowPeriodTime, ShowPlurals by Alan R Tonn
'
'Description: This function calculates the number of years, months, days,
hours, minutes and seconds between two dates, as elapsed time.
'
'Inputs: Interval: Intervals to be displayed (a string)
' Date1: The lower date (see below)
' Date2: The higher date (see below)
' ShowZero: Boolean to select showing zero elements
'
'Outputs: On error: Null
' On no error: Variant containing the number of years, months,
days, hours, minutes & seconds between
' the two dates, depending on the display interval selected.
' If Date1 is greater than Date2, the result will be a negative
value.
' The function compensates for the lack of any intervals not
listed. For example, if Interval lists "m", but
' not "y", the function adds the value of the year component
to the month component.
' the str? strings are for the kind of text the user wants to show
on the end of the amount of time for the
' interval. these are not optional but can be "".
' if the ShowPlurals is True all time outputs will show an "s" on
the end of the string the user inputs as
' the string that goes at the end of the time interval.
otherwise it shows nothing.
' if the ShowSpaces is true all time outputs will have a space
between the times and thier respective str? values
' if it is false all the numbers and interval strings will
connotate together with no space.
' if there are times that are future to your current timezone the
results will show negative if the ShowNegInterval is true.
' if the LargestIntervalOnly is true then the function only shows
the largest interval as an integer value. for example
' if the intervals allowed to show are "ymdhm" and the amount
of the interval was 0 years, 0 months, 0 days, 15 hours, 36 minutes
' then the result would be "15 hours". the largest amount will
always show, and only that interval.
' If ShowZero is True, and an output element is zero, it is
displayed. However, if ShowZero is False or
' omitted, no zero-value elements are displayed. For example,
with ShowZero = False, Interval = "ym",
' elements = 0 & 1 respectively, the output string will be "1
month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant

Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter

'Check that valid dates have been entered
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If

Diff2Dates = Null
varTemp = Null

'What intervals are supplied
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) -
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If

If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) -
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If

If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1,
"hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If

If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - IIf(Format$(Date1,
"nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If

If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) -
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If

If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If

'this section connects all the parts together. this is responsible for
giving the string of time intervals.
Select Case LargestIntervalOnly
Case False
If ShowPeriodTime = True Then
If lngDiffYears <> 0 Or lngDiffMonths <> 0 Or lngDiffDays <>
0 Or ShowZero = True Then
varTemp = "P"
End If
End If
If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then 'P_0Y_Ys,
varTemp = varTemp & IIf(ShowSpaces = True, " ", "") &
IIf(ShowLeadingZero And lngDiffYears <= 9, "0", "") & lngDiffYears &
IIf(ShowSpaces = True, " ", "") & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True, Chr(44), ""), strY)
End If

If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "") & IIf(ShowLeadingZero And lngDiffMonths <= 9,
"0", "") & lngDiffMonths & IIf(lngDiffMonths <> 1, IIf(ShowSpaces = True, "
", "") & strM & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strM))
End If
End If

If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffDays <= 9,
"0", "") & lngDiffDays & IIf(lngDiffDays <> 1, IIf(ShowSpaces = True, " ",
"") & strD & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strD)
End If
End If

If ShowPeriodTime = True Then
If (booCalcHours And lngDiffHours <> 0) Or (booCalcMinutes
And lngDiffMinutes <> 0) Or (booCalcSeconds And lngDiffSeconds <> 0) Or
ShowZero = True Then
varTemp = varTemp & " T"
End If
End If

If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffHours <= 9,
"0", "") & lngDiffHours & IIf(lngDiffHours <> 1, IIf(ShowSpaces = True, " ",
"") & strH & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strH)
End If
End If

If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffMinutes <=
9, "0", "") & lngDiffMinutes & IIf(lngDiffMinutes <> 1, IIf(ShowSpaces =
True, " ", "") & strN & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma =
True, Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strN)
End If
End If

If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffSeconds <=
9, "0", "") & lngDiffSeconds & IIf(lngDiffSeconds <> 1, IIf(ShowSpaces =
True, " ", "") & strS & IIf(ShowPlurals = True, "s", " "), IIf(ShowSpaces =
True, " ", "") & strS)
End If
End If
Case True
If lngDiffYears >= 1 Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", ""), strY)
ElseIf lngDiffMonths >= 1 Then
varTemp = lngDiffMonths & IIf(lngDiffMonths <> 1, strM &
IIf(ShowPlurals = True, "s", ""), strM)
ElseIf lngDiffDays >= 1 Then
varTemp = lngDiffDays & IIf(lngDiffDays <> 1, strD &
IIf(ShowPlurals = True, "s", ""), strD)
ElseIf lngDiffHours >= 1 Then
varTemp = lngDiffHours & IIf(lngDiffHours <> 1, strH &
IIf(ShowPlurals = True, "s", ""), strH)
ElseIf lngDiffMinutes >= 1 Then
varTemp = lngDiffMinutes & IIf(lngDiffMinutes <> 1, strN &
IIf(ShowPlurals = True, "s", ""), strN)
Else
varTemp = lngDiffSeconds & IIf(lngDiffSeconds <> 1, strS &
IIf(ShowPlurals = True, "s", ""), strS)
End If
End Select

If ShowNegInterval = True Then
If booSwapped Then
varTemp = "-" & varTemp
End If
End If

Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
Exit Function

Err_Diff2Dates:
Resume End_Diff2Dates

End Function

as you can see the if then's and booleans are a little out of hand. i am
trying to figure a way to cut back or make it easier to understand as well as
more efficient in terms of the whole function and variables inputted by the
users.

additionally in the future i may allow the users to configure this on a
personal level. maybe...

regardless, this function is then used in a query that loads the column in
to the list box. there is a report i will need to make that also shows the
same formatting, as well as an alert box or 2. i am trying to make it so that
i can configure each to match what i need in each spot.

any and all help appreciated.
 
Whoa. I think I walked off a cliff into a tar pit. That
function is too complex with so many options that I wouldn't
even consider changing it to add a bunch of additional
options. Maybe Graham or Duane might be willing to go
there, but I doubt it.

Can't you just pick a format and change the function to do
that one without trying to interweave more complexities?
 
Hello Marshall.

i guess i could. thats what i originally did.

the thing is like i said, i would like to be able to use the one function in
multiple places and have it formatted differently accordingly.

but the other way would be to make a different function for each format i
guess.

that seems kind of redundant though...

i was thinking that i could do something similar to the Interval String that
he uses to turn on and off the intervals that are calculated and then use
that to format the string.

sorry to scare you. :)

Marshall Barton said:
Whoa. I think I walked off a cliff into a tar pit. That
function is too complex with so many options that I wouldn't
even consider changing it to add a bunch of additional
options. Maybe Graham or Duane might be willing to go
there, but I doubt it.

Can't you just pick a format and change the function to do
that one without trying to interweave more complexities?
--
Marsh
MVP [MS Access]

whoops.

sorry.

here is the story so far: i am working on modifying the diff2date function
to fit what i need. i have a few different places that i want to be able to
output the information created by the diff2date function. one is in a list
box where the users will see how long a product has been out of commission. i
want to be able to use a string to format the results coming from the
diff2date function.

i had been working on formatting it by using optional boolean variables in
the function, but found that the more options i wanted the more i ended up
with a pain to manage the options. i thought it would be better if i created
the ability to use one string that told the function how to lay out the
results. i am already working on this idea, but was looking for a little help
on how to get the string to parse into the yes/no's that i needed to tell the
function to lay it out properly.

here is the code that i am using currently:
Public Function Diff2Dates(Interval, strY, strM, strD, strH, strN, strS As
String, Date1 As Date, Date2 As Date, _
Optional LargestIntervalOnly, Optional
ShowPlurals, Optional ShowSpaces, Optional ShowZero, _
Optional ShowNegInterval, Optional
ShowLeadingZero, Optional ShowPeriodTime, _
Optional ShowComma As Boolean = False) As Variant

'Author: Copyright 2001 Pacific Database Pty Limited Graham R Seach MCP
MVP (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593 This code is
freeware. Enjoy...
' (*) Amendments suggested by Douglas J. Steele MVP
' (*) Largest Interval Function, ShowSpaces, str?,
ShowNegInterval, ShowPeriodTime, ShowPlurals by Alan R Tonn
'
'Description: This function calculates the number of years, months, days,
hours, minutes and seconds between two dates, as elapsed time.
'
'Inputs: Interval: Intervals to be displayed (a string)
' Date1: The lower date (see below)
' Date2: The higher date (see below)
' ShowZero: Boolean to select showing zero elements
'
'Outputs: On error: Null
' On no error: Variant containing the number of years, months,
days, hours, minutes & seconds between
' the two dates, depending on the display interval selected.
' If Date1 is greater than Date2, the result will be a negative
value.
' The function compensates for the lack of any intervals not
listed. For example, if Interval lists "m", but
' not "y", the function adds the value of the year component
to the month component.
' the str? strings are for the kind of text the user wants to show
on the end of the amount of time for the
' interval. these are not optional but can be "".
' if the ShowPlurals is True all time outputs will show an "s" on
the end of the string the user inputs as
' the string that goes at the end of the time interval.
otherwise it shows nothing.
' if the ShowSpaces is true all time outputs will have a space
between the times and thier respective str? values
' if it is false all the numbers and interval strings will
connotate together with no space.
' if there are times that are future to your current timezone the
results will show negative if the ShowNegInterval is true.
' if the LargestIntervalOnly is true then the function only shows
the largest interval as an integer value. for example
' if the intervals allowed to show are "ymdhm" and the amount
of the interval was 0 years, 0 months, 0 days, 15 hours, 36 minutes
' then the result would be "15 hours". the largest amount will
always show, and only that interval.
' If ShowZero is True, and an output element is zero, it is
displayed. However, if ShowZero is False or
' omitted, no zero-value elements are displayed. For example,
with ShowZero = False, Interval = "ym",
' elements = 0 & 1 respectively, the output string will be "1
month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant

Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter

'Check that valid dates have been entered
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If

Diff2Dates = Null
varTemp = Null

'What intervals are supplied
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) -
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If

If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) -
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If

If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1,
"hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If

If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - IIf(Format$(Date1,
"nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If

If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) -
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If

If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If

'this section connects all the parts together. this is responsible for
giving the string of time intervals.
Select Case LargestIntervalOnly
Case False
If ShowPeriodTime = True Then
If lngDiffYears <> 0 Or lngDiffMonths <> 0 Or lngDiffDays <>
0 Or ShowZero = True Then
varTemp = "P"
End If
End If
If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then 'P_0Y_Ys,
varTemp = varTemp & IIf(ShowSpaces = True, " ", "") &
IIf(ShowLeadingZero And lngDiffYears <= 9, "0", "") & lngDiffYears &
IIf(ShowSpaces = True, " ", "") & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True, Chr(44), ""), strY)
End If

If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "") & IIf(ShowLeadingZero And lngDiffMonths <= 9,
"0", "") & lngDiffMonths & IIf(lngDiffMonths <> 1, IIf(ShowSpaces = True, "
", "") & strM & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strM))
End If
End If

If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffDays <= 9,
"0", "") & lngDiffDays & IIf(lngDiffDays <> 1, IIf(ShowSpaces = True, " ",
"") & strD & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strD)
End If
End If

If ShowPeriodTime = True Then
If (booCalcHours And lngDiffHours <> 0) Or (booCalcMinutes
And lngDiffMinutes <> 0) Or (booCalcSeconds And lngDiffSeconds <> 0) Or
ShowZero = True Then
varTemp = varTemp & " T"
End If
End If

If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffHours <= 9,
"0", "") & lngDiffHours & IIf(lngDiffHours <> 1, IIf(ShowSpaces = True, " ",
"") & strH & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strH)
End If
End If

If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffMinutes <=
9, "0", "") & lngDiffMinutes & IIf(lngDiffMinutes <> 1, IIf(ShowSpaces =
True, " ", "") & strN & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma =
True, Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strN)
End If
End If

If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffSeconds <=
9, "0", "") & lngDiffSeconds & IIf(lngDiffSeconds <> 1, IIf(ShowSpaces =
True, " ", "") & strS & IIf(ShowPlurals = True, "s", " "), IIf(ShowSpaces =
True, " ", "") & strS)
End If
End If
Case True
If lngDiffYears >= 1 Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", ""), strY)
ElseIf lngDiffMonths >= 1 Then
varTemp = lngDiffMonths & IIf(lngDiffMonths <> 1, strM &
IIf(ShowPlurals = True, "s", ""), strM)
ElseIf lngDiffDays >= 1 Then
varTemp = lngDiffDays & IIf(lngDiffDays <> 1, strD &
IIf(ShowPlurals = True, "s", ""), strD)
ElseIf lngDiffHours >= 1 Then
varTemp = lngDiffHours & IIf(lngDiffHours <> 1, strH &
IIf(ShowPlurals = True, "s", ""), strH)
ElseIf lngDiffMinutes >= 1 Then
varTemp = lngDiffMinutes & IIf(lngDiffMinutes <> 1, strN &
IIf(ShowPlurals = True, "s", ""), strN)
Else
varTemp = lngDiffSeconds & IIf(lngDiffSeconds <> 1, strS &
IIf(ShowPlurals = True, "s", ""), strS)
End If
End Select

If ShowNegInterval = True Then
If booSwapped Then
varTemp = "-" & varTemp
End If
End If

Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
Exit Function

Err_Diff2Dates:
Resume End_Diff2Dates

End Function

as you can see the if then's and booleans are a little out of hand. i am
Click to expand...
Click to expand...
 
Hello again

rereading your last post i realised that i missed something you said.

"That function is too complex with so many options that I wouldn't even
consider changing it to add a bunch of additional options. "

hmmm... i am not trying to add even more options. i am trying to cut back on
the optional stuff to bring it all together in a string that i would then use
to know what to format the results like. for example this is what i hope the
heading of my next version of this code will look like:

Public Function Diff2Dates2(Interval, ShowFormat, strY, strM, strD, strH,
strN, strS As String, Date1 As Date, Date2 As Date, Optional
LargestIntervalOnly, Optional ShowZero, Optional ShowNegInterval As Boolean =
False) As Variant

additionally i was thinking about taking all the str? variables and adding
them to the ShowFormat string. that would then allow me to format everything
based on one string and shorten the amount of responses necessary for the
function to work.

am i just over doing it? isnt the whole idea of programming to be as
efficient as possible and yet produce features that are needed? having one
function that can be diplayed and used in different ways and places would be
a qualifying reason to get this to work.

again i do have a working version that i am somewhat satisfied with. but i
was hoping to improve it.

read ya later...

Marshall Barton said:
Whoa. I think I walked off a cliff into a tar pit. That
function is too complex with so many options that I wouldn't
even consider changing it to add a bunch of additional
options. Maybe Graham or Duane might be willing to go
there, but I doubt it.

Can't you just pick a format and change the function to do
that one without trying to interweave more complexities?
--
Marsh
MVP [MS Access]

whoops.

sorry.

here is the story so far: i am working on modifying the diff2date function
to fit what i need. i have a few different places that i want to be able to
output the information created by the diff2date function. one is in a list
box where the users will see how long a product has been out of commission. i
want to be able to use a string to format the results coming from the
diff2date function.

i had been working on formatting it by using optional boolean variables in
the function, but found that the more options i wanted the more i ended up
with a pain to manage the options. i thought it would be better if i created
the ability to use one string that told the function how to lay out the
results. i am already working on this idea, but was looking for a little help
on how to get the string to parse into the yes/no's that i needed to tell the
function to lay it out properly.

here is the code that i am using currently:
Public Function Diff2Dates(Interval, strY, strM, strD, strH, strN, strS As
String, Date1 As Date, Date2 As Date, _
Optional LargestIntervalOnly, Optional
ShowPlurals, Optional ShowSpaces, Optional ShowZero, _
Optional ShowNegInterval, Optional
ShowLeadingZero, Optional ShowPeriodTime, _
Optional ShowComma As Boolean = False) As Variant

'Author: Copyright 2001 Pacific Database Pty Limited Graham R Seach MCP
MVP (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593 This code is
freeware. Enjoy...
' (*) Amendments suggested by Douglas J. Steele MVP
' (*) Largest Interval Function, ShowSpaces, str?,
ShowNegInterval, ShowPeriodTime, ShowPlurals by Alan R Tonn
'
'Description: This function calculates the number of years, months, days,
hours, minutes and seconds between two dates, as elapsed time.
'
'Inputs: Interval: Intervals to be displayed (a string)
' Date1: The lower date (see below)
' Date2: The higher date (see below)
' ShowZero: Boolean to select showing zero elements
'
'Outputs: On error: Null
' On no error: Variant containing the number of years, months,
days, hours, minutes & seconds between
' the two dates, depending on the display interval selected.
' If Date1 is greater than Date2, the result will be a negative
value.
' The function compensates for the lack of any intervals not
listed. For example, if Interval lists "m", but
' not "y", the function adds the value of the year component
to the month component.
' the str? strings are for the kind of text the user wants to show
on the end of the amount of time for the
' interval. these are not optional but can be "".
' if the ShowPlurals is True all time outputs will show an "s" on
the end of the string the user inputs as
' the string that goes at the end of the time interval.
otherwise it shows nothing.
' if the ShowSpaces is true all time outputs will have a space
between the times and thier respective str? values
' if it is false all the numbers and interval strings will
connotate together with no space.
' if there are times that are future to your current timezone the
results will show negative if the ShowNegInterval is true.
' if the LargestIntervalOnly is true then the function only shows
the largest interval as an integer value. for example
' if the intervals allowed to show are "ymdhm" and the amount
of the interval was 0 years, 0 months, 0 days, 15 hours, 36 minutes
' then the result would be "15 hours". the largest amount will
always show, and only that interval.
' If ShowZero is True, and an output element is zero, it is
displayed. However, if ShowZero is False or
' omitted, no zero-value elements are displayed. For example,
with ShowZero = False, Interval = "ym",
' elements = 0 & 1 respectively, the output string will be "1
month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant

Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter

'Check that valid dates have been entered
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If

Diff2Dates = Null
varTemp = Null

'What intervals are supplied
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) -
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If

If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) -
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If

If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1,
"hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If

If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - IIf(Format$(Date1,
"nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If

If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) -
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If

If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If

'this section connects all the parts together. this is responsible for
giving the string of time intervals.
Select Case LargestIntervalOnly
Case False
If ShowPeriodTime = True Then
If lngDiffYears <> 0 Or lngDiffMonths <> 0 Or lngDiffDays <>
0 Or ShowZero = True Then
varTemp = "P"
End If
End If
If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then 'P_0Y_Ys,
varTemp = varTemp & IIf(ShowSpaces = True, " ", "") &
IIf(ShowLeadingZero And lngDiffYears <= 9, "0", "") & lngDiffYears &
IIf(ShowSpaces = True, " ", "") & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True, Chr(44), ""), strY)
End If

If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "") & IIf(ShowLeadingZero And lngDiffMonths <= 9,
"0", "") & lngDiffMonths & IIf(lngDiffMonths <> 1, IIf(ShowSpaces = True, "
", "") & strM & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strM))
End If
End If

If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffDays <= 9,
"0", "") & lngDiffDays & IIf(lngDiffDays <> 1, IIf(ShowSpaces = True, " ",
"") & strD & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strD)
End If
End If

If ShowPeriodTime = True Then
If (booCalcHours And lngDiffHours <> 0) Or (booCalcMinutes
And lngDiffMinutes <> 0) Or (booCalcSeconds And lngDiffSeconds <> 0) Or
ShowZero = True Then
varTemp = varTemp & " T"
End If
End If

If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffHours <= 9,
"0", "") & lngDiffHours & IIf(lngDiffHours <> 1, IIf(ShowSpaces = True, " ",
"") & strH & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strH)
End If
End If

If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffMinutes <=
9, "0", "") & lngDiffMinutes & IIf(lngDiffMinutes <> 1, IIf(ShowSpaces =
True, " ", "") & strN & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma =
True, Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strN)
End If
End If

If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffSeconds <=
9, "0", "") & lngDiffSeconds & IIf(lngDiffSeconds <> 1, IIf(ShowSpaces =
True, " ", "") & strS & IIf(ShowPlurals = True, "s", " "), IIf(ShowSpaces =
True, " ", "") & strS)
End If
End If
Case True
If lngDiffYears >= 1 Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", ""), strY)
ElseIf lngDiffMonths >= 1 Then
varTemp = lngDiffMonths & IIf(lngDiffMonths <> 1, strM &
IIf(ShowPlurals = True, "s", ""), strM)
ElseIf lngDiffDays >= 1 Then
varTemp = lngDiffDays & IIf(lngDiffDays <> 1, strD &
IIf(ShowPlurals = True, "s", ""), strD)
ElseIf lngDiffHours >= 1 Then
varTemp = lngDiffHours & IIf(lngDiffHours <> 1, strH &
IIf(ShowPlurals = True, "s", ""), strH)
ElseIf lngDiffMinutes >= 1 Then
varTemp = lngDiffMinutes & IIf(lngDiffMinutes <> 1, strN &
IIf(ShowPlurals = True, "s", ""), strN)
Else
varTemp = lngDiffSeconds & IIf(lngDiffSeconds <> 1, strS &
IIf(ShowPlurals = True, "s", ""), strS)
End If
End Select

If ShowNegInterval = True Then
If booSwapped Then
varTemp = "-" & varTemp
End If
End If

Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
Exit Function

Err_Diff2Dates:
Resume End_Diff2Dates

End Function

as you can see the if then's and booleans are a little out of hand. i am
Click to expand...
Click to expand...
 
Trying to generalize the format is a serious complexity when
you consider the other options. I get a headache just
trying to think about the show zero option in conjunction
with an arbitrary format where you don't know where/what
part of the format to drop from the result.

OTOH, if you eliminate the other options so generalizing the
format is managable, then you can probably scrap the whole
function and just use the Format function.

FYI, in your function declaration:
Function Diff2Dates2(Interval, ShowFormat, strY, strM, _
strD, strH, strN, strS As String, ...
only strS is a dtring. The rest of the arguments default to
Variant.

If you really want all of those arguments to be strings,
then you need to use:

Function Diff2Dates2(Interval As String, _
ShowFormat As String, strY As String, _
strM As String, strD As String, _
strH As String, strN As String, _
strS As String, ...
 
Trying to generalize the format is a serious complexity when
you consider the other options.  I get a headache just
trying to think about the show zero option in conjunction
with an arbitrary format where you don't know where/what
part of the format to drop from the result.

OTOH, if you eliminate the other options so generalizing the
format is managable, then you can probably scrap the whole
function and just use the Format function.

FYI, in your function declaration:
        Function Diff2Dates2(Interval, ShowFormat, strY, strM, _
                                                                               strD, strH, strN, strS As String, ...
only strS is a dtring.  The rest of the arguments default to
Variant.

If you really want all of those arguments to be strings,
then you need to use:

        Function Diff2Dates2(Interval As String, _
                                                        ShowFormat As String, strY As String, _
                                                        strM As String, strD As String, _
                                                        strH As String, strN As String, _
                                                        strS As String, ...
--
Marsh
MVP [MS Access]


rereading your last post i realised that i missed something you said.
Click to expand...
"That function is too complex with so many options that I wouldn't even
consider changing it to add a bunch of additional options. "
Click to expand...
hmmm... i am not trying to add even more options. i am trying to cut back on
the optional stuff to bring it all together in a string that i would then use
to know what to format the results like. for example this is what i hopethe
heading of my next version of this code will look like:
Click to expand...
Public Function Diff2Dates2(Interval, ShowFormat, strY, strM, strD, strH,
strN, strS As String, Date1 As Date, Date2 As Date, Optional
LargestIntervalOnly, Optional ShowZero, Optional ShowNegInterval As Boolean =
False) As Variant
Click to expand...
additionally i was thinking about taking all the str? variables and adding
them to the ShowFormat string. that would then allow me to format everything
based on one string and shorten the amount of responses necessary for the
function to work.
Click to expand...
am i just over doing it? isnt the whole idea of programming to be as
efficient as possible and yet produce features that are needed? having one
function that can be diplayed and used in different ways and places would be
a qualifying reason to get this to work.
Click to expand...
again i do have a working version that i am somewhat satisfied with. buti
was hoping to improve it.- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...

oh. dang. i had seen that done somewhere else and thought that the
last one in a chain like that would determine the others. ok. thanks.
 
Trying to generalize the format is a serious complexity when
you consider the other options.  I get a headache just
trying to think about the show zero option in conjunction
with an arbitrary format where you don't know where/what
part of the format to drop from the result.

OTOH, if you eliminate the other options so generalizing the
format is managable, then you can probably scrap the whole
function and just use the Format function.

FYI, in your function declaration:
        Function Diff2Dates2(Interval, ShowFormat, strY, strM, _
                                                                                strD, strH, strN, strS As String, ...
only strS is a dtring.  The rest of the arguments default to
Variant.

If you really want all of those arguments to be strings,
then you need to use:

        Function Diff2Dates2(Interval As String, _
                                                        ShowFormat As String, strY As String, _
                                                        strM As String, strD As String, _
                                                        strH As String, strN As String, _
                                                        strS As String, ...
--
Marsh
MVP [MS Access]


rereading your last post i realised that i missed something you said.
Click to expand...
"That function is too complex with so many options that I wouldn't even
consider changing it to add a bunch of additional options. "
Click to expand...
hmmm... i am not trying to add even more options. i am trying to cut backon
the optional stuff to bring it all together in a string that i would thenuse
to know what to format the results like. for example this is what i hope the
heading of my next version of this code will look like:
Click to expand...
Public Function Diff2Dates2(Interval, ShowFormat, strY, strM, strD, strH,
strN, strS As String, Date1 As Date, Date2 As Date, Optional
LargestIntervalOnly, Optional ShowZero, Optional ShowNegInterval As Boolean =
False) As Variant
Click to expand...
additionally i was thinking about taking all the str? variables and adding
them to the ShowFormat string. that would then allow me to format everything
based on one string and shorten the amount of responses necessary for the
function to work.
Click to expand...
am i just over doing it? isnt the whole idea of programming to be as
efficient as possible and yet produce features that are needed? having one
function that can be diplayed and used in different ways and places wouldbe
a qualifying reason to get this to work.
Click to expand...
again i do have a working version that i am somewhat satisfied with. but i
was hoping to improve it.- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...

one question, does that work as well for the "= false" as the default
thing?
 
DawnTreader said:
FYI, in your function declaration:
        Function Diff2Dates2(Interval, ShowFormat, strY, strM, _
                                                                                strD, strH, strN, strS As String, ...
only strS is a dtring.  The rest of the arguments default to
Variant.

If you really want all of those arguments to be strings,
then you need to use:

        Function Diff2Dates2(Interval As String, _
                                                        ShowFormat As String, strY As String, _
                                                        strM As String, strD As String, _
                                                        strH As String, strN As String, _
                                                        strS As String, ...
rereading your last post i realised that i missed something you said.
Click to expand...
"That function is too complex with so many options that I wouldn't even
consider changing it to add a bunch of additional options. "
Click to expand...
hmmm... [snip] for example this is what i hope the
heading of my next version of this code will look like:
Click to expand...
Public Function Diff2Dates2(Interval, ShowFormat, strY, strM, strD, strH,
strN, strS As String, Date1 As Date, Date2 As Date, Optional
LargestIntervalOnly, Optional ShowZero, Optional ShowNegInterval As Boolean =
False) As Variant
Click to expand...
Click to expand...

oh. dang. i had seen that done somewhere else and thought that the
last one in a chain like that would determine the others. ok. thanks.
Click to expand...


Maybe in another programming language, but not in VBA.
 
DawnTreader said:
one question, does that work as well for the "= false" as the default
thing?
Click to expand...


Not sure what you mean? The =False is the default value of
the optional argument and has nothing to do with the type of
the argument. If you are asking if you need to repeat
=False for each optional argument, then the answer is Yes.
 
Hello again Marshall

i was thinking about what you said in the post i am responding to.

is there any dangers in having a function this complex? the only thing that
doesnt work the way i want, yet, is the layout of the results.

the format function works only for dates, does it not? how would i get it to
choose what interval i wanted it to show, and whether or not i wanted it to
show zero intervals with the format function?

again at this point i am just curious... :)

Marshall Barton said:
Whoa. I think I walked off a cliff into a tar pit. That
function is too complex with so many options that I wouldn't
even consider changing it to add a bunch of additional
options. Maybe Graham or Duane might be willing to go
there, but I doubt it.

Can't you just pick a format and change the function to do
that one without trying to interweave more complexities?
--
Marsh
MVP [MS Access]

whoops.

sorry.

here is the story so far: i am working on modifying the diff2date function
to fit what i need. i have a few different places that i want to be able to
output the information created by the diff2date function. one is in a list
box where the users will see how long a product has been out of commission. i
want to be able to use a string to format the results coming from the
diff2date function.

i had been working on formatting it by using optional boolean variables in
the function, but found that the more options i wanted the more i ended up
with a pain to manage the options. i thought it would be better if i created
the ability to use one string that told the function how to lay out the
results. i am already working on this idea, but was looking for a little help
on how to get the string to parse into the yes/no's that i needed to tell the
function to lay it out properly.

here is the code that i am using currently:
Public Function Diff2Dates(Interval, strY, strM, strD, strH, strN, strS As
String, Date1 As Date, Date2 As Date, _
Optional LargestIntervalOnly, Optional
ShowPlurals, Optional ShowSpaces, Optional ShowZero, _
Optional ShowNegInterval, Optional
ShowLeadingZero, Optional ShowPeriodTime, _
Optional ShowComma As Boolean = False) As Variant

'Author: Copyright 2001 Pacific Database Pty Limited Graham R Seach MCP
MVP (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593 This code is
freeware. Enjoy...
' (*) Amendments suggested by Douglas J. Steele MVP
' (*) Largest Interval Function, ShowSpaces, str?,
ShowNegInterval, ShowPeriodTime, ShowPlurals by Alan R Tonn
'
'Description: This function calculates the number of years, months, days,
hours, minutes and seconds between two dates, as elapsed time.
'
'Inputs: Interval: Intervals to be displayed (a string)
' Date1: The lower date (see below)
' Date2: The higher date (see below)
' ShowZero: Boolean to select showing zero elements
'
'Outputs: On error: Null
' On no error: Variant containing the number of years, months,
days, hours, minutes & seconds between
' the two dates, depending on the display interval selected.
' If Date1 is greater than Date2, the result will be a negative
value.
' The function compensates for the lack of any intervals not
listed. For example, if Interval lists "m", but
' not "y", the function adds the value of the year component
to the month component.
' the str? strings are for the kind of text the user wants to show
on the end of the amount of time for the
' interval. these are not optional but can be "".
' if the ShowPlurals is True all time outputs will show an "s" on
the end of the string the user inputs as
' the string that goes at the end of the time interval.
otherwise it shows nothing.
' if the ShowSpaces is true all time outputs will have a space
between the times and thier respective str? values
' if it is false all the numbers and interval strings will
connotate together with no space.
' if there are times that are future to your current timezone the
results will show negative if the ShowNegInterval is true.
' if the LargestIntervalOnly is true then the function only shows
the largest interval as an integer value. for example
' if the intervals allowed to show are "ymdhm" and the amount
of the interval was 0 years, 0 months, 0 days, 15 hours, 36 minutes
' then the result would be "15 hours". the largest amount will
always show, and only that interval.
' If ShowZero is True, and an output element is zero, it is
displayed. However, if ShowZero is False or
' omitted, no zero-value elements are displayed. For example,
with ShowZero = False, Interval = "ym",
' elements = 0 & 1 respectively, the output string will be "1
month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant

Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter

'Check that valid dates have been entered
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If

Diff2Dates = Null
varTemp = Null

'What intervals are supplied
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) -
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If

If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) -
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If

If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1,
"hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If

If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - IIf(Format$(Date1,
"nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If

If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) -
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If

If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If

'this section connects all the parts together. this is responsible for
giving the string of time intervals.
Select Case LargestIntervalOnly
Case False
If ShowPeriodTime = True Then
If lngDiffYears <> 0 Or lngDiffMonths <> 0 Or lngDiffDays <>
0 Or ShowZero = True Then
varTemp = "P"
End If
End If
If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then 'P_0Y_Ys,
varTemp = varTemp & IIf(ShowSpaces = True, " ", "") &
IIf(ShowLeadingZero And lngDiffYears <= 9, "0", "") & lngDiffYears &
IIf(ShowSpaces = True, " ", "") & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True, Chr(44), ""), strY)
End If

If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "") & IIf(ShowLeadingZero And lngDiffMonths <= 9,
"0", "") & lngDiffMonths & IIf(lngDiffMonths <> 1, IIf(ShowSpaces = True, "
", "") & strM & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strM))
End If
End If

If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffDays <= 9,
"0", "") & lngDiffDays & IIf(lngDiffDays <> 1, IIf(ShowSpaces = True, " ",
"") & strD & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strD)
End If
End If

If ShowPeriodTime = True Then
If (booCalcHours And lngDiffHours <> 0) Or (booCalcMinutes
And lngDiffMinutes <> 0) Or (booCalcSeconds And lngDiffSeconds <> 0) Or
ShowZero = True Then
varTemp = varTemp & " T"
End If
End If

If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
'P_0Y_Ys,_0M_Ms,_0D_Ds,
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffHours <= 9,
"0", "") & lngDiffHours & IIf(lngDiffHours <> 1, IIf(ShowSpaces = True, " ",
"") & strH & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma = True,
Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strH)
End If
End If

If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffMinutes <=
9, "0", "") & lngDiffMinutes & IIf(lngDiffMinutes <> 1, IIf(ShowSpaces =
True, " ", "") & strN & IIf(ShowPlurals = True, "s", " ") & IIf(ShowComma =
True, Chr(44), ""), IIf(ShowSpaces = True, " ", "") & strN)
End If
End If

If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null,
IIf(ShowSpaces = True, " ", "")) & IIf(ShowLeadingZero And lngDiffSeconds <=
9, "0", "") & lngDiffSeconds & IIf(lngDiffSeconds <> 1, IIf(ShowSpaces =
True, " ", "") & strS & IIf(ShowPlurals = True, "s", " "), IIf(ShowSpaces =
True, " ", "") & strS)
End If
End If
Case True
If lngDiffYears >= 1 Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, strY &
IIf(ShowPlurals = True, "s", ""), strY)
ElseIf lngDiffMonths >= 1 Then
varTemp = lngDiffMonths & IIf(lngDiffMonths <> 1, strM &
IIf(ShowPlurals = True, "s", ""), strM)
ElseIf lngDiffDays >= 1 Then
varTemp = lngDiffDays & IIf(lngDiffDays <> 1, strD &
IIf(ShowPlurals = True, "s", ""), strD)
ElseIf lngDiffHours >= 1 Then
varTemp = lngDiffHours & IIf(lngDiffHours <> 1, strH &
IIf(ShowPlurals = True, "s", ""), strH)
ElseIf lngDiffMinutes >= 1 Then
varTemp = lngDiffMinutes & IIf(lngDiffMinutes <> 1, strN &
IIf(ShowPlurals = True, "s", ""), strN)
Else
varTemp = lngDiffSeconds & IIf(lngDiffSeconds <> 1, strS &
IIf(ShowPlurals = True, "s", ""), strS)
End If
End Select

If ShowNegInterval = True Then
If booSwapped Then
varTemp = "-" & varTemp
End If
End If

Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
Exit Function

Err_Diff2Dates:
Resume End_Diff2Dates

End Function

as you can see the if then's and booleans are a little out of hand. i am
Click to expand...
Click to expand...
 
DawnTreader said:
i was thinking about what you said in the post i am responding to.

is there any dangers in having a function this complex?
Click to expand...

The danger is that there are more opportunities for bugs in
code that is difficult to follow. Encapsulating common
logic in separate functions usually helps simplify the main
function, but if not done carefully the logic can be further
obscurred.

The only thing that
doesnt work the way i want, yet, is the layout of the results.
the format function works only for dates, does it not?
Click to expand...

Search for "Format Property" in VBA Help. There are
different formatting options for different types of values.
Because you have to allow for suppressing or showing zero
intervals, I don't see how you can use a date format for the
whole thing. This means that you would have to check each
interval for zero and if it should be included in the result
or not. I suspect that just concatenating the values may be
all you can use.

How would i get it to
choose what interval i wanted it to show, and whether or not i wanted it to
show zero intervals with the format function?
Click to expand...

That is where much of the complexity comes in. Essentially,
you are trying to create a new, unrestricted kind of date
formatting. The hide/show zero intervals is the main reason
why you can not use the standard Format function with date
formatting codes.
 
Back
Top