Can I get Excel to call my macro for number formatting?

[LurfysMa]

Is there any way to get Excel (2007) to call a custom macro to format
the (numeric) contents of a cell but leave the cell contents as a
number that can be used in calculations in other cells?



I have a bunch of cells containing time intervals stored as floating
point numbers in units of days. These are not dates, but they are
stored in the same format. Some examples:

1 1 day
2.5 2.5 days or 2 days, 12 hours
0.9 .9 days or 21.6 hours
3/24 3 hours
0.125 3 hours
1/24 1 hour
0.0416667 1 hour
30/60/24 30 minutes
0.020833 30 minutes

and so on.

These values are calculated using a function I wrote:

=MyFun(C15,B11,c)

They can range from 1 second (1/60/60/24 - .000011574) to several
years (5*365.25 = 1,826.25). I need the raw numners for calculations,
but I would like to see the nearest units displayed, something like:

nnn.nu

where "nnn.n" is a floating point number formatted to 1 decimal place
and "u" is a character indicating the units (Y=years, D=days, H=hours,
M=minutes, S=seconds).

I have a macro (attached below) from a VB6 application that does this
formatting. The macro will chose the largest units that have at least
1 digit on the left of the decimal place. For example:

Raw Number Displayed As
1 1.0D
2.5 2.5D
0.9 21.6H
3/24 3.0H
0.125 3.0H
1/24 1.0H
0.0416667 1.0H
30/60/24 30.0M
0.020833 30.0M
12.3/60/60/24 12.3S
730.5 1.5Y

I have copied this macro over to Excel. It works if I call it from a
cell, such as:

=FmtInt(MyFun(C5,B11,c))

This works perfectly, but the result in the cell is a string (text)
and I cannot do arithmetic with it.

Is there some way that I can get Excel to call my macro to do the
formatting and display the formatted result (like using one of the
custom patterns), but leave the cell contents as is?





In case anyone is interested, here's the formatting macro:



'************************************************************************
' Format Interval Function
'
' Formats a time interval as nnn.nu
'
' nnn.n = interval to 1 decimal place
' u = units: Y=years, D=days, H=hours, M=minutes, S=seconds
'
' Syntax: y = FmtInt(interval)
'
' Note: The format function

Public Function FmtInt(ByVal interval As Double) As String

Const TSYear As Double = 365.25 ' 1 year
Const TSDay As Double = 1 ' 1 day
Const TSHour As Double = TSDay / 24 ' 1 hour
Const TSMin As Double = TSHour / 60 ' 1 minute
Const TSSec As Double = TSMin / 60 ' 1 second
' Note: if a variable number of decimal places are needed,
' this constant must be generated dynamically
Const FmtPat As String = "0.0" ' The format function pattern

If Format(interval / TSYear, FmtPat) >= TSYear Then 'If >= 1 year,
FmtInt = Format(interval / TSYear, FmtPat) & "Y" 'Format in
years
ElseIf Format(interval, FmtPat) >= TSDay Then 'If >= 1 day,
FmtInt = Format(interval, FmtPat) & "D" 'Format in
days
ElseIf Format(interval / TSHour, FmtPat) >= TSHour Then 'If >= 1 hour,
FmtInt = Format(interval / TSHour, FmtPat) & "H" 'Format in
hours
ElseIf Format(interval / TSMin, FmtPat) >= TSMin Then 'If >- 1
minute
FmtInt = Format(interval / TSMin, FmtPat) & "M" 'Format in
minutes
Else 'Otherwise,
FmtInt = Format(interval / TSSec, FmtPat) & "S" 'Format in
seconds
End If

End Function


--

 

[Guest]

What you are trying to accomplish is a great idea.

However you need to set the format, which a function can not do. A function
can only return a value, which is why you are stuck with strings.

If this is a specific range of cells, like a column, consider using an Event
Macro to detect inputs to the cells and set custom formats accordingly

 

[LurfysMa]

What you are trying to accomplish is a great idea.

However you need to set the format, which a function can not do.

So there is no way to get the Excel formatting facility to call my
macro to do the formatting? Pity. That would seem like a very powerful
feature.

A function
can only return a value, which is why you are stuck with strings.

If this is a specific range of cells, like a column, consider using an Event
Macro to detect inputs to the cells and set custom formats accordingly

Can this Event Macro do calculations? If not, I'm screwed, because
none of the custom formats will work. I need to do some calculations.

--

 

[LurfysMa]

The function I posted won't work. It has a bug. Here is the corrected
function. Sorry.


'************************************************************************
' Format Interval Function
'
' Formats a time interval as nnn.nu
'
' nnn.n = interval to 1 decimal place
' u = units: Y=years, D=days, H=hours, M=minutes, S=seconds
'
' Syntax: y = FmtInt(interval)
'
' Note: The format function

Public Function FmtInt(ByVal interval As Double) As String

Const TSYear As Double = 365.25 ' 1 year
Const TSDay As Double = 1 ' 1 day
Const TSHour As Double = TSDay / 24 ' 1 hour
Const TSMin As Double = TSHour / 60 ' 1 minute
Const TSSec As Double = TSMin / 60 ' 1 second
' Note: if a variable number of decimal places are needed,
' this constant must be generated dynamically
Const FmtPat As String = "0.0" ' The format function pattern

If Format(interval / TSYear, FmtPat) >= 1 Then
FmtInt = Format(interval / TSYear, FmtPat) & "Y"
ElseIf Format(interval, FmtPat) >= 1 Then
FmtInt = Format(interval, FmtPat) & "D"
ElseIf Format(interval / TSHour, FmtPat) >= 1 Then
FmtInt = Format(interval / TSHour, FmtPat) & "H"
ElseIf Format(interval / TSMin, FmtPat) >= 1 Then
FmtInt = Format(interval / TSMin, FmtPat) & "M"
Else
FmtInt = Format(interval / TSSec, FmtPat) & "S"
End If

End Function

--

 

[Guest]

No reason to be sorry (but there is stilll a problem).

I examined your function, putting test values in column A and the function
call in Column B:

99999 273.8Y
0.01 14.4M
0.9 21.6H
0.99 1.0D
500 1.4Y
1000 2.7Y

Note that .99 results in 1 Day rather than 23.8 Hours

Here is the event code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then
Exit Sub
End If

Const TSYear As Double = 365.25 ' 1 year
Const TSDay As Double = 1 ' 1 day
Const TSHour As Double = TSDay / 24 ' 1 hour
Const TSMin As Double = TSHour / 60 ' 1 minute
Const TSSec As Double = TSMin / 60 ' 1 second

v = Target.Value
dq = Chr(34) ' double quote
Select Case v
Case Is > TSYear
v = v / TSYear
s = "Y"
Case Is > TSDay
v = v / TSDay
s = "D"
Case Is > TSHour
v = v / TSHour
s = "H"
Case Is > TSMin
v = v / TSMin
s = "M"
Case Else
s = "S"
End Select
Application.EnableEvents = False
Target.Offset(0, 1).Value = v
Target.Offset(0, 1).NumberFormat = "0.0" & dq & s & dq
Application.EnableEvents = True
End Sub

Once installed, type a value in column A and the result will appear in
column B complete with formatting. Because it is event code, it is very easy
to install and automatic to use:

1. right-click the tab name near the bottom of the window
2. select View Code - this brings up a VBE window
3. paste the stuff in and close the VBE window

If you have any concerns, first try it on a trial worksheet.

If you save the workbook, the macro will be saved with it.


To remove the macro:

1. bring up the VBE windows as above
2. clear the code out
3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

To learn more about Event Macros (worksheet code), see:

http://www.mvps.org/dmcritchie/excel/event.htm

 

[LurfysMa]

No reason to be sorry (but there is stilll a problem).
Damn!

I examined your function, putting test values in column A and the function
call in Column B:

99999 273.8Y
0.01 14.4M
0.9 21.6H
0.99 1.0D
500 1.4Y
1000 2.7Y

Note that .99 results in 1 Day rather than 23.8 Hours

Good catch. I was testing the values backwards.

Here's a complete rewrite (also replacing years with weeks):

Public Function FmtInt(ByVal interval As Double) As String

Const TSWeek As Double = 7 ' 1 week in days
Const TSDay As Double = 1 ' 1 day in days
Const TSHour As Double = TSDay / 24 ' 1 hour in days
Const TSMin As Double = TSHour / 60 ' 1 minute in days
Const TSSec As Double = TSMin / 60 ' 1 second in days
Const FmtPat As String = "0.0" ' The format function pattern

If Format(interval / TSSec, FmtPat) < 60 Then 'If < 60 seconds
(1 minute),
FmtInt = Format(interval / TSSec, FmtPat) & "S" 'Format in
seconds
ElseIf Format(interval / TSMin, FmtPat) < 60 Then 'If < 60 minutes
(1 hour),
FmtInt = Format(interval / TSMin, FmtPat) & "M" 'Format in
minutes
ElseIf Format(interval / TSHour, FmtPat) < 24 Then 'If < 24 hours
(1 day),
FmtInt = Format(interval / TSHour, FmtPat) & "H" 'Format in
hours
ElseIf Format(interval, FmtPat) < 7 Then 'If < 7 days (1
weeek),
FmtInt = Format(interval, FmtPat) & "D" 'Format in
days
Else 'Otherwise,
FmtInt = Format(interval / TSWeek, FmtPat) & "W" 'Format in
weeks
End If

End Function


I'll study your Event Code later.

Thanks for the help and for doing my debugging for me ;-)

Hey, it works for Microsoft!

--