Custom Format for hours and minutes

[Paul D. Simon]

Probably not possible, but thought I'd ask anyway...

I altered the h:mm time format to the custom format
h "hrs", m "mins". So, if I type 3:3, the cell reads "3 hrs, 3 mins"
just fine. But if I type 1:1, I get "1 hrs, 1 mins" . Is there some
custom format that will drop off the "s" when the hour or minute is
"1"? Furthermore, can such a format drop off the hour or minute
altogether if a "0"?

Here's a recap of what I'm looking for:

I Type Cell Reads
------- -------------
2:2 2 hrs, 2 mins
2:1 2 hrs, 1 min
1:2 1 hr, 2 mins
1:1 1 hr, 1 min
0:2 2 mins
0:1 1 min
2:0 2 hrs
1:0 1 hr


Many thanks.

 

[Mike]

"But if I type 1:1, I get "1 hrs, 1 mins""
Well, that is exactly what you told excel to behave!. To get what you want
you need (without VB) is to special format those individual cells.

 

[Dave Peterson]

Not by formatting alone...

But you could use a worksheet event that formats the cell depending on what you
type into that cell.

This seemed to work ok for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim MinStr As String
Dim HourStr As String
Dim myNumberFormat As String

With Target
If .Cells.Count > 1 Then Exit Sub
If Intersect(.Cells, Me.Range("a:a")) Is Nothing Then Exit Sub
If IsNumeric(.Value2) = False Then Exit Sub

Select Case Minute(.Value2)
Case Is = 0
MinStr = ""
Case Is = 1
MinStr = """ min"""
Case Else
MinStr = """ mins"""
End Select

Select Case CLng(Application.Text(.Value, "[hh]"))
Case Is = 0
HourStr = ""
Case Is = 1
HourStr = """ hr"""
Case Else
HourStr = """ hrs"""
End Select

myNumberFormat = ""
If HourStr = "" Then
If MinStr <> "" Then
myNumberFormat = "[m]" & MinStr
End If
Else
myNumberFormat = "[h]" & HourStr
If MinStr <> "" Then
myNumberFormat = myNumberFormat & """, """ & "m" & MinStr
End If
End If

.NumberFormat = myNumberFormat
End With

End Sub

If you want to try it, rightclick on the worksheet tab that should have this
behavior. Select view code and paste this into the code window.

I used all of column A to look for these values:
If Intersect(.Cells, Me.Range("a:a")) Is Nothing Then Exit Sub
Change this range if you need to.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

You can read more about these kinds of events at:
Chip Pearson's site:
http://www.cpearson.com/excel/events.htm

David McRitchie's site:
http://www.mvps.org/dmcritchie/excel/event.htm

 

[Paul D. Simon]

Dave,

This works absolutely perfectly - exactly what I was looking for.

Thank you very much - I appreciate the amount of work and time you
spent developing this code for me.

Best regards,
Paul

 

[Dave Peterson]

Glad it worked ok.

Dave,

This works absolutely perfectly - exactly what I was looking for.

Thank you very much - I appreciate the amount of work and time you
spent developing this code for me.

Best regards,
Paul