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)
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

yourtwizted

New Member
Joined
Feb 7, 2020
Messages
12
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,965
.
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
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,049
Office Version
  1. 2010
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,572
Messages
5,625,583
Members
416,119
Latest member
JCLLE

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
Top