Convert time to a 1 hour range

[Livin404]

Greetings I have in Column B a 24 hour time in a text format for example 1150. I need to get it to display 30 minutes prior and 30 minutes post, so I would need it to display “1120 – 1220” in Column B.



I know the formulas if I were to use the formula bar; however, I need a VBA so users could edit the end results, and I don’t want to lose my formulas.

Using the formula method, I had to create more columns to get my result. I’m hoping with a VBA it can all appear in the original Column. With the time put in Column D “1150” I had to establish the time in Column H with a formula of ”

 =TIMEVALUE(LEFT(D2,2)&":"&MID(D2,3,2))

” and that gave me 11:50. For Column I which now I’ll use Column H as my source I used the formula “

=MOD(H2-0.5/24,1)

” that would give me “11:20” this also accounts for if a time that would roll back to the previous day. For Column J I would use the formula “

=(H2+0.5/24)

” to get value 12:20. In Column K I used “

=TEXT(I2,"hh:mm")&"-"&TEXT(J2,"hh:mm")

” this would result in 11:20-12:20 and the format would be in General. Lastly I would need leave it in General format, so I can drop the colons; this is the formula I used “

=SUBSTITUTE(K2,":","")

” this results in 1120-1220. These work as designed, but I'm hoping to make the next step and not have the formulas. Thank you,

 

[Peter_SSs]

See if this does what you want.

Sub Time_Range()
  With Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = "=TEXT(1+REPLACE(RC[-1],3,0,"":"")-1/48,""hhmm-"")&TEXT(REPLACE(RC[-1],3,0,"":"")+1/48,""hhmm"")"
    .Value = .Value
  End With
End Sub

Test data & results:

20 11 15.xlsm
	A	B
1	Text Time	Hour Range
2	1150	1120-1220
3	0225	0155-0255
4	2225	2155-2255
5	2350	2320-0020
6	0001	2331-0031
Time range

 

[Livin404]

See if this does what you want.

Sub Time_Range()
  With Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = "=TEXT(1+REPLACE(RC[-1],3,0,"":"")-1/48,""hhmm-"")&TEXT(REPLACE(RC[-1],3,0,"":"")+1/48,""hhmm"")"
    .Value = .Value
  End With
End Sub

Test data & results:

20 11 15.xlsm
	A	B
1	Text Time	Hour Range
2	1150	1120-1220
3	0225	0155-0255
4	2225	2155-2255
5	2350	2320-0020
6	0001	2331-0031
Time range

Thanks for getting back with me on that. It's been a few days. In the mean time I came up with

Function GET30MINRANGE(strTime As String) As String
Dim strRange, strHour, strMin, lowerBound, upperBound As String
Dim timeVal As Date

strMin = Mid(strTime, 3, 2)
strHour = Left(strTime, 2)
timeVal = Date + TimeValue(strHour & ":" & strMin)

lowerBound = Format(timeVal - TimeSerial(0, 30, 0), "hhnn")
upperBound = Format(timeVal + TimeSerial(0, 30, 0), "hhnn")
strRange = lowerBound & "-" & upperBound

GET30MINRANGE = strRange
End Function

Then I use the code:

=IFERROR(GET30MINRANGE(B2),"")

in column H. It gives me the results I need after a macro is used to cut and paste the values in. The only thing I need now is it to ignore the word ETA in Column B. I got it to ignore blanks spaces, but still trying to to get to ignore ETA. I want ETA to remain in the Column. I did try yours but it did end up putting the formula in the cells; I'm sure it's an oversight on my part. I will like your submission, so others don't respond. I tried to delete the post but couldn't figure out how. Many thanks again.

 

[Peter_SSs]

If you have developed the udf to use in the worksheet then you could perhaps consider using native worksheet functions instead since they are generally more efficient than udfs?

Adapting my previous approach to allow for blanks and ETA, what about the formulas in columns G:H below?
Two formulas because I wasn't quite sure what you meant about "keeping ETA" - didn't know whether you meant in column B or the formula column.

Livin404_1.xlsm
	B	C	D	E	F	G	H
1	Text Time					Hour Range	Hour Range
2	1150					1120-1220	1120-1220
3	0225					0155-0255	0155-0255
4
5	ETA					ETA
6	2225					2155-2255	2155-2255
7	2350					2320-0020	2320-0020
8	0001					2331-0031	2331-0031
Time range

Cell Formulas
Range	Formula
G2:G8	G2	=IFERROR(TEXT(1+REPLACE(B2,3,0,":")-1/48,"hhmm-")&TEXT(REPLACE(B2,3,0,":")+1/48,"hhmm"),B2&"")
H2:H8	H2	=IFERROR(TEXT(1+REPLACE(B2,3,0,":")-1/48,"hhmm-")&TEXT(REPLACE(B2,3,0,":")+1/48,"hhmm"),"")

 

[Livin404]

If you have developed the udf to use in the worksheet then you could perhaps consider using native worksheet functions instead since they are generally more efficient than udfs?

Adapting my previous approach to allow for blanks and ETA, what about the formulas in columns G:H below?
Two formulas because I wasn't quite sure what you meant about "keeping ETA" - didn't know whether you meant in column B or the formula column.

Livin404_1.xlsm
	B	C	D	E	F	G	H
1	Text Time					Hour Range	Hour Range
2	1150					1120-1220	1120-1220
3	0225					0155-0255	0155-0255
4
5	ETA					ETA
6	2225					2155-2255	2155-2255
7	2350					2320-0020	2320-0020
8	0001					2331-0031	2331-0031
Time range

Cell Formulas
Range	Formula
G2:G8	G2	=IFERROR(TEXT(1+REPLACE(B2,3,0,":")-1/48,"hhmm-")&TEXT(REPLACE(B2,3,0,":")+1/48,"hhmm"),B2&"")
H2:H8	H2	=IFERROR(TEXT(1+REPLACE(B2,3,0,":")-1/48,"hhmm-")&TEXT(REPLACE(B2,3,0,":")+1/48,"hhmm"),"")

I want to keep the ETA. The formula I have is fine. I already got the VBA to copy and paste cells values back into Column B, so just need to tweak the one formula to include ignore ETA. I will try yours the one that keeps ETA to see what happens. Thanks

 

[Livin404]

Hey I just tried the formula you had in Column G and it works brilliant. Its a longer formula but the VBA is shorter thank you!! I was wondering how hard would it get your formula in worksheet "Inbound FIDS" Column H as a VBA? There are about 8 macros for that worksheet and one of the earlier ones calls for columns to be deleted, and I do not want the formula there until Column B is positioned from another Column. Your work continues to inspire me. Thank you so much.

 

[Peter_SSs]

I already got the VBA to copy and paste cells values back into Column B

Somehow I missed that you were putting the values back into column B, though I now can see you said that right at the start.

So, yet another way if you want to try it, without using any helper columns or formulas on the worksheet.

Sub Time_Range_v2()
  With Range("B2", Range("B" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(#="""","""",iferror(text(1+replace(#,3,0,"":"")-1/48,""hhmm-"")&text(replace(#,3,0,"":"")+1/48,""hhmm""),#))", "#", .Address))
  End With
End Sub

If you do want to stick with your udf and using a helper column in the worksheet, then just change your worksheet formula to

=IFERROR(GET30MINRANGE(B2),B2&"")

 

[Livin404]

That last entry you made is by far the best, and it just saved me from 2-3 extra macros. How can I make it for worksheet ("Inbound FIDS")? Thank you!

 

[Peter_SSs]

How can I make it for worksheet ("Inbound FIDS")?

Do you mean that 'Inbound FIDS' is not, or may not be, the active sheet?

 

[Livin404]

Yes, I have a Run_Fids Button which activates about six macros on my “72 Hr”worksheet sending it to “Inbound FIDS”. So I would need something to identify the sheet to be “Inbound FIDS”. It’s a huge project I’ve been working on for the past three weeks. I have about 26 macros to get me the “ 72 Hr” worksheet. Your input nearly completes everything. I just got one other macro that needs just a small change then I’m done. I’ll post that later. Thank you so much.