vba use specific value based off of current time

yourtwizted

New Member
Joined
Feb 7, 2020
Messages
12
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hey guys,
so at work i occasionally have to send a email to some bigger bosses and they like the text to have a time based on a 15 minute standard,
i attempted to do something like
Rich (BB code):
Dim Time  as string
Dim Time1 as string

If Time > TimeValue("06:00:00") and Time < TimeValue("06:14:59") Then
     Time1 = "07:00:00" 
     Else
If Time > TimeValue("06:15:00") and Time < TimeValue("06:29:59") Then
     Time1 = "07:15:00" 
     Else

and so on until the end of my shift, i get an error at the end stating "Block If without End If" the following is the end of the coding i have

Rich (BB code):
If Time > TimeValue("22:45:00") and Time < TimeValue ("22:59:59") Then
    Time1 = "23:45:00"
    Else
    MsgBox ("No Time Found")
End If

is there an easier way to do this? (my email generation works already i just need to fix or improve the time issue)
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Upvote 0
.
Here is a VBA Macro Code method. I believe it includes everything but you will need to test completely :

VBA Code:
Option Explicit

Sub cmdRound_Click()
Dim intHrs As Integer, intMin As Integer, optType As Integer
Dim dteTime As Date

' convert entered time to Time value
dteTime = CDate(Now)

'extract parts of time
intHrs = DatePart("h", dteTime)
intMin = DatePart("n", dteTime)

If optType = 1 Then 'test for nearest type
    
    'Round to nearest hour
    If intMin >= 30 Then
        dteTime = DateAdd("h", 1, dteTime)
        dteTime = DateAdd("n", -intMin, dteTime)
    Else
        dteTime = DateAdd("n", -intMin, dteTime)
    End If
Else
    'Round to quarter hour
    Select Case intMin
        Case Is < 1
            intMin = 0
        Case 1 To 15
            intMin = 0
        Case 16 To 29
            intMin = 15
        Case 30 To 44
            intMin = 30
        Case 45 To 59
           intMin = 45
        End Select
    dteTime = TimeSerial(intHrs, intMin, 0)
End If

MsgBox dteTime

End Sub
 
Upvote 0
Try
VBA Code:
Time1 = Format(Int(TimeValue(Time) * 96) / 96 + (1 / 24), "hh:mm:ss")

But Time is a VBA key word and best not used as the variable name
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top