Adding three zeros "000"

Question

Greetings, the following VBA runs great and does what it is designed to. This is the end result where the only thing I need is a 4 digit numeric value representing the 24 hour clock without the colon. If I have a number 1-9 it will add three zeros. If I have a two digit number it will add two zeros, if I have a three digit number it will add one zeros. What I need it to do is if I have a zero (0) I need it to add three zeroes for an end result of "0000".

Again I only need this macro to adjust to add three zeros in front of a lone zero. Thank you,

VBA Code:

Sub twenty_four_hour_Clock() With Range("D1", Range("D" & Rows.Count).End(xlUp)) x = .Address .NumberFormat = "@" .Value = Evaluate("if(len(" & x & ")=3,""0""&" & x & "," & x & ")") .Value = Evaluate("if(len(" & x & ")=2,""00""&" & x & "," & x & ")") .Value = Evaluate("if(len(" & x & ")<2,""""," & x & ")") End With End Sub

Answer 1

I posted using an old and unused profile above.

embry, again, you are pushing the good nature of the experts on this site to a limit that is becoming increasingly uncomfortable. We don't get paid to answer questions in these forums. We do it because we enjoy helping people. But there is only so much we can do. Try to keep your questions narrow and focused. Bound the problem as best you can. Describe the problem concisely, especially the inputs and outputs. There is absolutely nothing wrong with getting help on larger complex projects, but you have to be the project manager and reduce the challenges down to bite size chunks that can be answered in a few minutes.

As I stated before, here is a solution that solves your original problem, and the problem as you stated just now.

Here is a generic routine that does what you want to cells that contain a date time value in what we believe is the most raw format given some target range. This routine is aware of the format of the original raw value so it won't edit a cell that contains a value other than that. To use it, call it passing to it one cell, an entire column, or the whole worksheet. It will take every cell containing a date time value, convert it to a real date time value, subtract 8 hours, and place back into the cell the time only in 24 hour format and formatted as a text value to retain leading zeros.

For example, to process all values in column D as you are trying to do in your original routine:

Sub twenty_four_hour_Clock()

    ConvertDateTime Range("D1", Range("D" & Rows.Count).End(xlUp))

End Sub

Here is the routine:

Sub ConvertDateTime(ByVal Target As Range)

    Dim Cell As Range

    Dim Value As Variant

    Set Target = Intersect(Target, Target.Parent.UsedRange)

    For Each Cell In Target.Cells

        Value = Trim(Replace(CStr(Cell.Value), Chr(160), " "))

        If Value Like "## [A-Za-z][A-Za-z][A-Za-z] #### ####" Then

            Value = CDate(Left(Value, 11) & Space(1) & Mid(Value, 13, 2) & ":" & Mid(Value, 15, 2))

            Value = Value - TimeSerial(8, 0, 0)

            Cell.NumberFormat = "@"

            Cell.Value = Format(Value, "HHMM")

        End If

    Next Cell

End Sub

Answer 2

Dear embry

I completely understand your situation, and I prize your efforts, commitment and time invested in this project.

And I sure you will sort this out.

But I'm 100% agree with Andreas comments, and I hope don't disrespect.

My humble suggestion.

1- Create a new file with sheets and sufficient raw data (exactly as you receive it from the air trans & Exec system)

2- On other sheets (manually) show us your data in the way you want your data to be transformed

3- You may add an info sheet detailing the input process and some other details

4- Create a new thread on the forum with a link to the new file and asking for a macro that would transform your data in the way you require.

This will allow members in this forum to create from the scratch the code(s) with their own approach and expertise rather than fix (patch) bits and pieces of multiple codes.

And meanwhile, you could use the code you currently have.

Last thing

Regarding your thread

 Insert colored row with data if empty

IMHO: 

Using Conditional Formatting would be a solution. Please, consider it.

Regards

Jeovany

Answer 3

I’ve been testing this thing and it has been solid.

If you say so, I can not agree...

Anyway, I want to give you a little insight into my thoughts:

https://www.dropbox.com/s/jp1pwifhvtz4esf/1845093c-8286-4339-b4cf-df561994307d.xlsm?dl=1

I'm sure I did not catch all details of your code, because you makes many things so complicated.

I need just 125 lines in my macro (including many comments and blank lines !) and a helper function to transform all data from sheet Source into sheet "72 Hr".

In my opinion, this is a much easier way than the one you went.

Andreas.

Answer 4

Hi embry

I hope you are OK and doing well

We haven't had any reply from you on your previous threads in this forum

Would you mind to let us know if our answers were correct?

Did the codes and offered suggestions help you?

Thank you in advance for any comment or rating on that regard

Regarding this thread,

Here is the macro

****************************************************************************

Sub twenty_four_hour_Clock()

Dim addzeroes As String

Dim digit As Range

Range("D1", Range("D" & Rows.Count).End(xlUp)).NumberFormat = "@"

For Each digit In Range("D1", Range("D" & Rows.Count).End(xlUp))

    addzeroes = Application.WorksheetFunction.Rept("0", 4 - Len(digit))

    digit.Value = digit.Value & addzeroes

Next digit

End Sub

*******************************************************************************************

Regards

Answer 5

Sub twenty_four_hour_Clock()

With Range("D1", Range("D" & Rows.Count).End(xlUp))

x = .Address

.NumberFormat = "@"

.Value = Evaluate("if(len(" & x & ")=3,""0""&" & x & "," & x & ")")

.Value = Evaluate("if(len(" & x & ")=2,""00""&" & x & "," & x & ")")

.Value = Evaluate("if(len(" & x & ")<2,""""," & x & ")")

.Value = Evaluate("if(len(" & x & ")=0,""0000""," & x & ")")

.Value = Evaluate("if(" & x & "=""0"",""0000""," & x & ")")

End With

End Sub