Solved

Excel: Military time Maco add 0

Posted on 2012-03-12
20
232 Views
Last Modified: 2012-03-12
I have a script that adds a colon to military time in excel.

This script takes 0600 and makes it 6:00.

Problem is for example 6:00 doesn't have a zero when it's changed in the beginning. I need it to say 06:00

I have the script, can someone fix it to say this instead?

Thank you!!
Dim strTime As String
Set rg = Intersect(Range("G:G"), ActiveSheet.UsedRange)
For Each c In rg.Cells
    If IsNumeric(c) Then
        Select Case Len(c)
            Case 1
                strTime = "00:0" & c
            Case 2
                strTime = "00:" & c
            Case 3
                strTime = Left(c, 1) & ":" & Right(c, 2)
            Case 4
                strTime = Left(c, 2) & ":" & Right(c, 2)
        End Select
        c = strTime
    End If
Next c
          

Open in new window

0
Comment
Question by:Pancake_Effect
  • 11
  • 8
20 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 37712817
change line 15 to:

c.value = format(strTime,"0:00")
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712827
I did that and it changed most of the numbers inaccurately to zeros

Screenshot attached
results.PNG
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712829
Yea, I get that now, lol.  Hang a sec...

Dave
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712836
Also I need it as 00:00 not 0:00 (sorry if I confused you)

Thanks!!!
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712838
No worries - are these real times, or just text that you're formatting?

Dave
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712847
It's just plain text. It's just auto generated numbers from a program that spit it out as raw data here on excel.

(It's a garbage program hence why I've been posting a lot on these forums lately in the excel section haha)
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712852
Good.  This should work - you were ALMOST there.  Needed to padd zeros ahead, and then put a ' prefix character so it remains as text.

Here's your code:

Sub test()

Dim strTime As String
Set rg = Range("G5:G8")
For Each c In rg.Cells
    If IsNumeric(c) Then
        Select Case Len(c)
            Case 1
                strTime = "00:0" & c
            Case 2
                strTime = "00:" & c
            Case 3
                strTime = "0" & Left(c, 1) & ":" & Right(c, 2)
            Case 4
                strTime = Left(c, 2) & ":" & Right(c, 2)
        End Select
        c.Value = "'" & strTime
    End If
Next c
          

End Sub

Open in new window


Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712859
I'm not sure why you're testing the intersect with the UsedRange - is it because perhaps one of the cells is NOT in the usedrange?  If so, you might change that back.

This one checks to ensure the cell is NOT empty (IsNumeric will be TRUE on a blank cell):
Sub test()

Dim strTime As String
    Set rg = Range("G5:G8")
    For Each c In rg.Cells
        If IsNumeric(c.Value) And c.Value <> vbNullString Then
            Select Case Len(c)
            Case 1
                strTime = "00:0" & c
            Case 2
                strTime = "00:" & c
            Case 3
                strTime = "0" & Left(c, 1) & ":" & Right(c, 2)
            Case 4
                strTime = Left(c, 2) & ":" & Right(c, 2)
            End Select
            c.Value = "'" & strTime
            strTime = vbNullString
        End If
    Next c


End Sub

Open in new window


Dave
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712894
Works great! Must have to go through a lot, has to think for a bit. But it works as intended.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712896
How many cells are you really processing?

Dave
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712903
This is what my macro is - attached (Your script is close to the bottom)

For the dates there is one column with 91 cells.

The entire sheet is A-X by the 91 cells.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712906
I'm not sure why its running slow - may be your machine?  Not a lot of data.

I have something that will convert the data to actual times, and it may run faster.

interested?  or must you have string/text output?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712908
This works on the same input, but converts the output to actual time, with formatting to show it in 00:00 format.

Private Sub test2()
Dim rg As Range
Dim c As Range
Dim timeVal As Date

    Set rg = Range("G5:G8")
    For Each c In rg
        If c < 1000 Then
            timeVal = TimeValue("0" & Left(c, 1) & ":" & Right(c, 2))
        End If
        If c >= 1000 Then
            timeVal = TimeValue(Left(c, 2) & ":" & Right(c, 2))
        End If

        c = timeVal
        c.NumberFormat = "hh:mm;@"
    Next c


End Sub

Open in new window

0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712919
If I want to change the scope which ones would I change? As you can see in my previous attached script it flows with others.

I essentially just added the:

    Set rg = Range("G5:G8")
   

Open in new window

to

    Set rg = Range("W:W")
   

Open in new window


Shouldn't that work?

Keeps on saying out of scope cannot compile.

I am putting this in that long script in the same place the old script was on my attached document with the very long script.
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37712927
W:W is A LOT to process.

you need that intersect back, like this:
Sub test()

Dim strTime As String
    Set rg = Intersect(Range("W:W"), ActiveSheet.UsedRange)
    For Each c In rg.Cells
        If IsNumeric(c.Value) And c.Value <> vbNullString Then
            Select Case Len(c)
            Case 1
                strTime = "00:0" & c
            Case 2
                strTime = "00:" & c
            Case 3
                strTime = "0" & Left(c, 1) & ":" & Right(c, 2)
            Case 4
                strTime = Left(c, 2) & ":" & Right(c, 2)
            End Select
            c.Value = "'" & strTime
            strTime = vbNullString
        End If
    Next c


End Sub

Open in new window


Dave
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37712949
Runs nice and fast!!

Out of curiosity (nothing wrong with the current code) I notice it moves the numbers to the left of the column.

I have no idea what they want, they can just format it themselves. But is there a place in that code that specifies that? I'm just asking because I noticed it moves it.

Thanks!
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712957
It is just left justifying the text.  putting the 'Prefix character in uses the default left justify.

Not to create confusion, but I was looking at speed ---

FYI - if X column is available, this may even run faster (though you can change offsets and set in another empty column if needed):
Sub test3()
Dim strTime As String

    Set rg = Intersect(Range("W:W"), ActiveSheet.UsedRange)
    rg.Offset(, 1).Formula = "=SUMPRODUCT(--TEXT(RC[-1],""00\:00""))"
    rg.Offset(, 1).NumberFormat = "hh:mm;@"
    rg.Offset(, 1).Value = rg.Offset(, 1).Value
    rg.Formula = "=TEXT(RC[1],""HH:MM"")"
    rg.Copy
    rg.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    rg.Offset(, 1).ClearContents


End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712968
For example, this code creates the temporary work column, 100 columns to the right, then cleans up after.   It probably is the fastest code I can think of - no looping!
Sub test3()
Dim strTime As String

    Set rg = Intersect(Range("W:W"), ActiveSheet.UsedRange)
    rg.Offset(, 100).Formula = "=SUMPRODUCT(--TEXT(RC[-100],""00\:00""))"
    'rg.Offset(, 1).NumberFormat = "hh:mm;@"
    rg.Offset(, 100).Value = rg.Offset(, 100).Value
    rg.Formula = "=TEXT(RC[100],""HH:MM"")"
    rg.Copy
    rg.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    rg.Offset(, 100).ClearContents


End Sub

Open in new window


Cheers,

Dave
0
 
LVL 4

Author Closing Comment

by:Pancake_Effect
ID: 37712972
Thanks for taking your time out to help! You helped me solve all the problems, and I even learned a thing or two.

Again thanks!
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 37713118
The code will bomb if there isn't 3 characters.  You could simplify slightly to (both loop and non-loop):

Sub ConvertFromMilitaryTime_Loop()

    Dim rCell As Range
    Dim dtStart As Integer
    Dim dtEnd As Double
    On Error Resume Next 'for SpecialCells
    For Each rCell In Range("G:G").SpecialCells(xlCellTypeConstants)
        If IsNumeric(rCell.Value) Then
            dtStart = rCell.Value
            dtEnd = Int(dtStart / 100) + (((dtStart / 100) - Int(dtStart / 100)) / 0.6)
            dtEnd = dtEnd / 24
            rCell.Value = dtEnd
            rCell.NumberFormat = "hh:mm"
        End If
    Next rCell

End Sub

Sub ConvertFromMilitaryTime_NoLoop()

    Dim rTest As Range
    Dim rFormula As Range
    Columns(8).Insert
    Set rTest = Range("G1:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    Set rFormula = rTest.Offset(0, 1)
    rFormula.Formula = "=(INT(G1/100)+(((G1/100)-INT(G1/100))/0.6))/24"
    rFormula.Value = rFormula.Value
    rTest.Value = rFormula.Value
    rTest.NumberFormat = "hh:mm"
    Columns(8).Delete

End Sub

HTH

Regards,
Zack Barresse
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now