Excel: Military time Maco add 0

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

LVL 4
Pancake_EffectAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
change line 15 to:

c.value = format(strTime,"0:00")
0
Pancake_EffectAuthor Commented:
I did that and it changed most of the numbers inaccurately to zeros

Screenshot attached
results.PNG
0
dlmilleCommented:
Yea, I get that now, lol.  Hang a sec...

Dave
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

Pancake_EffectAuthor Commented:
Also I need it as 00:00 not 0:00 (sorry if I confused you)

Thanks!!!
0
dlmilleCommented:
No worries - are these real times, or just text that you're formatting?

Dave
0
Pancake_EffectAuthor Commented:
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
dlmilleCommented:
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
dlmilleCommented:
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
Pancake_EffectAuthor Commented:
Works great! Must have to go through a lot, has to think for a bit. But it works as intended.
0
dlmilleCommented:
How many cells are you really processing?

Dave
0
Pancake_EffectAuthor Commented:
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
dlmilleCommented:
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
dlmilleCommented:
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
Pancake_EffectAuthor Commented:
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
dlmilleCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Pancake_EffectAuthor Commented:
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
dlmilleCommented:
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
dlmilleCommented:
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
Pancake_EffectAuthor Commented:
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
Zack BarresseCEOCommented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.