Solved

# Turn current time into a percentage of 24 hours.

Posted on 2006-04-28
167 Views
Hi,

What I have is a time in a textbox. The time can either be in 12 or 24 hr format (whichever is easier to work with.)

What I need to do is to turn this figure into a percentage of 24 hours...

So eg 12:00pm would be 50% (as we are half way through the day...) I need the percentage for hours AND minutes so 12:01pm would be 50. errrr something percent!!

Does anyone have any idea how this can be done?

Many thanks...

Dave.
0
Question by:wildarmsdave

LVL 13

Expert Comment

Convert the time to Double and then multiply by 100.

Pct = CDbl(Tm) * 100

HTH-Jon
0

LVL 85

Expert Comment

Something like...

Option Explicit

Private Sub Command1_Click()
Dim p As String
p = TimePercentage(Text1.Text)
MsgBox p
End Sub

Private Function TimePercentage(ByVal tm As String) As String
If IsDate(Text1.Text) Then
Dim dt As Date
dt = CDate(Text1.Text)
Dim pct As Double
pct = ((Hour(dt) * 60) + Minute(dt)) / 1440 * 100
TimePercentage = Format(pct, "0.00") & "%"
End If
End Function
0

LVL 85

Expert Comment

Ooops...I didnt' change the parameter in my function...should be:

Private Function TimePercentage(ByVal tm As String) As String
If IsDate(tm) Then
Dim dt As Date
dt = CDate(tm)
Dim pct As Double
pct = ((Hour(dt) * 60) + Minute(dt)) / 1440 * 100
TimePercentage = Format(pct, "0.00") & "%"
End If
End Function
0

LVL 9

Expert Comment

Try this
This code snippet designed with the following assumptions
a) the available time is in 24Hrs format.If you want to change it as 12 Hrs format then use one more flag to determine am/pm.
b) The Hrs & Mts seperator is :, If it something different make suitable code changes according to that
c) the name of the text box is txtTime
d) Result is showned in 'lblPercentage'(Lable control)

Dim HrsMts as Integer, Hrs as Single, Mts as Byte
Dim strTemp() as String
Dim Result as Single
strTemp = Split(txtTime.Text,":")
Hrs = strTemp(0)
Mts = strTemp(1)
Hrs = Hrs + (Csng(Mts)/60)
Result = Hrs / Csng(24) * Csng(100)
lblPercentage.Caption = Format(Result,"#0.00%")
0

LVL 26

Expert Comment

I think jmundsack's code works great

8->

May be i.m wrong and i have not test yet
0

LVL 85

Accepted Solution

I couldn't get jmundsacks code to work...maybe I missed something...    ?
0

LVL 26

Expert Comment

may be just

Pct = CDbl(cdate(text1.text))) * 100
0

LVL 85

Expert Comment

That works EDDYKT.

Though it won't work if the entry in the TextBox contains a FULL date such as "4/28/06 11:00 AM".

Whereas my approach doesn't care.  If the entry in the textbox contains a valid date and/or date/time, it will correctly return the "percentage" that the entered date/time represents for that day.

If there is no time portion, then it becomes midnight for that day and 0.00% is returned.
0

LVL 26

Expert Comment

If it works, don't take my comment as answer

Take jmundsack's
0

LVL 26

Expert Comment

you can just modify to support with date

i.e.

d = CDate(Text1.Text) - CLng(CDate(Text1.Text))
If d < 0 Then d = 1 + d
Debug.Print CDbl(d) * 100
0

LVL 85

Expert Comment

Fair enough...but IMHO, my code is alot easier to read and understand...  =)

Private Function TimePercentage(ByVal tm As String) As String
If IsDate(tm) Then
Dim dt As Date
dt = CDate(tm)
Dim pct As Double
pct = ((Hour(dt) * 60) + Minute(dt)) / 1440 * 100
TimePercentage = Format(pct, "0.00") & "%"
End If
End Function

Private Function TimePercentage(ByVal tm As String) As String
If IsDate(tm) Then
Dim dt As Date
dt = CDate(Text1.Text) - CLng(CDate(Text1.Text))
If dt < 0 Then
dt = 1 + dt
End If
TimePercentage = Format(CDbl(dt) * 100, "0.00") & "%"
End If
End Function

But again, that's just my opinion!...
0

LVL 13

Expert Comment

I think the more sophisticated functions with better error control deserve the points.

Jon
0

LVL 9

Expert Comment

you will get some idea on this

http://nsm1.nsm.iup.edu/rwinstea/metricclock.shtm
0

LVL 9

Expert Comment

the conversation tooks place between experts only. There is no interaction from author??????? Dear Author Please give feedback.
0

Author Comment

Hey guys. Sorry I haven't replied in a while but I''ve been moving house and haven't had internet access. I'm going on holiday for a week now but will try these suggestions once I get back.

As usual, thanks to everyone that's replied. Your help and comments are appreciated.
0

Author Comment

Phew! I've finally had chance to try this. Many apologies for the delay, espesh' as you were all so quick in replying. I've awarded Idle Mind the points purley because his was the 2nd reply and the first version I could get to work. Many thanks to everyone else.

Dave.
0

LVL 9

Expert Comment

Nice decision
0

## Featured Post

### Suggested Solutions

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…