Run message box when cell value time is exceed system time - vba

I have a excel file.
I wish to write a Excel vba to compare the system time and the cell value time.
If system time is exceed the cell value time, it will show a pop out message to inform user that, the time is exceed.
My file will look like this:
I have been research a while but seem like only vba code will able to complete this requirement.

Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
SysTime = Now()
Finalrow = Cells(Rows.Count, 14).End(xlUp).Row
'Column 14 stands for N, change as required
For I = 6 To Finalrow
'6 stands for first row filled with value, change as required
ValueTime = Cells(I, 14).Value
If TimeValue(ValueTime) < TimeValue(SysTime) Then
Cells(I, 14).Offset(, 1).Value = "Time is exceeeded" '1 is offsetting to column O. Use 2 for column P, 3 for Q and so on, as you prefer.
MsgBox ("Time is exceeeded for user entry in N" & I)
'To store the time error in adjacent O column cells, and to popup for each error
'Remove either as required - esp MsgBox, it is very annoying - put only because you asked in original question
End If
Next I
End Sub

If you want only advise the guest that the time input does not exceed the current, you don't need a vba (intersect will be one way) you can use the validate date
and you can customize the input msg and also the error msg if the value isn't correct.

Example
Sub TimeNow()
Dim cValue As Date '// Cell Value
Dim sTime As Date '// System
cValue = Sheets("Sheet1").Range("B2").Value
sTime = TimeValue(Now)
If sTime > cValue Then
MsgBox "TiMe iS Up. STOP " & TimeValue(Now)
Else: Exit Sub
'or do something
End If
End Sub

You can use the function TimeValue, which returns the value of time as a number between 0 and 1. Posting a simple code to check on cell N6 alone.
/// You may, of course, use loops to check for a range of cells, or use the excel events, or keyboard shortcuts to run the macro.///
Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
ValueTime = Range("N6").Value
SysTime = Now()
If TimeValue(ValueTime) < TimeValue(SysTime) Then
MsgBox ("Time is exceeeded")
End If
End Sub

Related

Error Reading Cell Date

I am trying to create a button that will hide rows based on the date the function reads.
My excel sheet is for meeting minutes, and based off column D, I will decide whether to hide or show the cell row. Now, column D contains dates of particular minutes, but occasionally contains a string called "Date" as part of a header row. For some reason, I cannot successfully write an if statement to skip said rows. Therefore, I am getting an error where my variable Current_Date is assigned the default VBA date value and my code crashes.
I made sure to format those particular cells as "Text" on the spread sheet, but it seems like my if statement still does not execute.
Can some one please provide me with some guidance.
Thank you in advance.
Private Sub CommandButton1_Click()
Dim x As Integer
Dim Current_Date As Date
Dim Last_Meeting_Date As Date
Dim default_date As Date
' Loop to hide old meeting minutes
For x = 150 To 1000
If Worksheets("Minutes").Cells(x,4) = "Date" Then
x = x + 1
End If
Current_Date = Worksheets("MINUTES").Cells(x, 4)
Last_Meeting_Date = Worksheets("HOME").Cells(19, 16)
If Current_Date < Last_Meeting_Date Then
Worksheets("MINUTES").Rows(x).Hidden = True
End If
Next x
End Sub
You might try:
Private Sub CommandButton1_Click()
Dim x As Integer
Dim Current_Date As Date
Dim Last_Meeting_Date As Date
Dim default_date As Date
Last_Meeting_Date = Worksheets("HOME").Cells(19, 16)
' Loop to hide old meeting minutes
For x = 150 To 1000
If Worksheets("Minutes").Cells(x,4) <> "Date" Then 'You might want to use IsDate()?
Current_Date = Worksheets("MINUTES").Cells(x, 4)
'original code is only able to hide row, this one can unhide them as well
Worksheets("MINUTES").Rows(x).Hidden = (Current_Date < Last_Meeting_Date)
End If
Next x
End Sub
I took a few liberties in reformatting and simplifying your code. I reordered the declarations, removed 'default date' since it was unused, changed your references to column '4' to 'D', reversed the logic of your if statement, and used a 'With' statement to prevent repeated specifications of your Worksheet.
Private Sub CommandButton1_Click()
Dim Last_Meeting_Date As Date
Last_Meeting_Date = CDate(Worksheets("HOME").Cells(19, 16).Value2)
Dim x As Long
Dim Current_Date As Date
' Loop to hide old meeting minutes
With Worksheets("MINUTES")
For x = 150 To 1000
If CStr(.Cells(x, "D").Value2) <> "Date" Then
Current_Date = CDate(.Cells(x, "D").Value2)
If Current_Date < Last_Meeting_Date Then .Rows(x).Hidden = True
End If
Next x
End With
End Sub

VBA: Search for a value in a column, find the next cell that match the value if adjacent cell not empty

I'm pretty newbie at coding in vba (i'm actually learning on the spot as i've been required to do it so), and I'm having a little trouble getting this right.
What I need is to be able to search for a value {clave} and then insert the current date into the adjacent cell, but I haven't found the way to do it without having it overwrite the very first match.
At first I thought I could do it with a Loop, but I can't quite put my finger on it and I've been running in circles.
Is I haven't found the solution, I just left it as it is, but heres my code:
Private Sub buscarbtn_Click()
Dim clv1
Dim rnng As Range
clv1 = clavebx.Value
'Insert date
prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6).Value = Date
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub
And a quick look at my table so you can picture what I'm trying to do.
Thank you in advance!
Once you found the CLAVE ID check if the cell value is empty, if not empty place the date value.
Private Sub buscarbtn_Click()
Dim clv1 As String
Dim rnng As Range
Dim clave_found As Range
clv1 = clavebx.Value
'Insert date
Set clave_found = prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6)
With clave_found
If .Value = vbNullString Then
.Value = Date
Else
MsgBox "The [CLAVE] ID found with date: " & .Value
End If
End With
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub

Excel VBA - Find out difference in hours

I have a column with value
09:00 - 21:00
Trying to find out how can I get the difference in hours, ie. for this example 12.
you can use this function
Function GetHourDifference(cell As Range) As Long
GetHourDifference = Hour(Split(cell.Value, "-")(1)) - Hour(Split(cell.Value, "-")(0))
End Function
to be exploited in your main code as follows
MsgBox GetHourDifference(Range("a1")) '<--| if cell "A1" has value "09:00 - 21:00" it returns: 12
If you are looking for a formula solution, i'd go with the following:
=HOUR(RIGHT(C24,5))-HOUR(LEFT(C24,5))
Which works as long as your values are always in the format provided.
If you are looking for a VBA solution I'd go with that of #user3598756
Option Explicit
Sub Macro1()
Dim txtDate As String
Dim i As Integer
Dim varDateDif As Variant, split1 As Variant, split2 As Variant
' Cell with times
txtDate = Range("A2").Value
' Split the cell using the delimiter -
varDateDif = Split(txtDate, "-")
For i = 0 To LBound(varDateDif)
split1 = varDateDif(i) ' First time
split2 = varDateDif(i + 1) ' Second time
Next i
' Difference in hours
Range("B2").Value = Abs(CDate(split1) - CDate(split2))
' Difference in minutes
Range("C2").Value = DateDiff("n", split1, split2)
End Sub
if your 09.00 - 21.00 is in cell B7, then this works:
=TIME(RIGHT(B7,5),RIGHT(B7,2),)-TIME(LEFT(B7,5),MID(B7,4,2),)
very brute force, as it assumes that the time is always 00.00 and no other characters will ever be included.

Excel-VBA get number from letter equivalent entry in a textbox

I have a user form that asks for a column reference to be entered into a TextBox. I am trying to make it so that the number replaces the letter in the code. I am using the Cells(a,b) format to do this. Which is why I need the number to replace the letter.
Worksheets("AIO").Cells(X, TextBox3).Value = Worksheets("FDSA").Cells(Y, TextBox4).Value
Hence in the previous code when: x=2, TextBox3.Value=A, y=4, and TextBox4.Value=AA
The code will work as
Worksheets("AIO").Cells(2, 1).Value = Worksheets("FDSA").Cells(4, 27).Value
The only thing I can think of making is a huge if statement were I code something similar like this:
If textbox3.value ="A" then
textbox3.value=1
elseif textbox3.value=E then
textbox3.value=5
.......
.......
textbox3.value=AD then
textbox3.value=30
End If
If you want to keep it uncomplicated, .Cells can use the column string instead of number
Sub test()
'From sheet module
Debug.Print Me.Cells(1, 1).Address 'prints $A$1
Debug.Print Me.Cells(1, "A").Address 'also prints $A$1
End Sub
You might have to validate that it's a valid column ID but you probably need to do that even converting it to a number.
On way to get a column number from a character string:
Sub ColumnNumber()
Dim s As String
Dim L As Long
s = "AB"
L = Cells(1, s).Column
MsgBox L
End Sub

Excel VBA date formats

I've got a spreadsheet that contains a number of dates. These generally appear in either mm/dd/yyyy or mm/dd/yyyy hh:mm.
The problem is that the dates aren't always put in correctly and I want to have checks to make sure they are dates in the code.
My original thought was to use IsDate to check or CDate but this didn't seem to work: it was still returning strings instead of dates.
I've since set up a small experiment which shows that these functions don't work the way I expect them to. Methodology is:
In a cell A1 I enter the formula =DATE(2013,10,28)
Cell B1 formula =A1*1 which should equal a number (41575)
Run this little script
Sub test()
MsgBox ("Start:" & TypeName(ActiveCell.Value) & " " & IsDate(ActiveCell.Value))
ActiveCell.Value = Format(ActiveCell.Value, "mm/dd/yyyy")
MsgBox ("After format: " & TypeName(ActiveCell.Value) & " " & IsDate(ActiveCell.Value))
ActiveCell.Value = CDate(ActiveCell.Value)
MsgBox ("After Cdate: " & TypeName(ActiveCell.Value) & " " & IsDate(ActiveCell.Value))
End Sub
When the script starts the cell is a of type date and IsDate returns true. After it is run through Format it is of type string but IsDate still returns true. CDate will also convert the cell to a string. Cell B1 will also now return 0 (since its a string*1).
So I guess to summarize the questions:
Why are Format and CDate changing my cells to strings?
How can I ensure that a cell will return a date value and not just a string that looks like a date?
It's important to distinguish between the content of cells, their display format, the data type read from cells by VBA, and the data type written to cells from VBA and how Excel automatically interprets this. (See e.g. this previous answer.) The relationship between these can be a bit complicated, because Excel will do things like interpret values of one type (e.g. string) as being a certain other data type (e.g. date) and then automatically change the display format based on this. Your safest bet it do everything explicitly and not to rely on this automatic stuff.
I ran your experiment and I don't get the same results as you do. My cell A1 stays a Date the whole time, and B1 stays 41575. So I can't answer your question #1. Results probably depend on how your Excel version/settings choose to automatically detect/change a cell's number format based on its content.
Question #2, "How can I ensure that a cell will return a date value": well, not sure what you mean by "return" a date value, but if you want it to contain a numerical value that is displayed as a date, based on what you write to it from VBA, then you can either:
Write to the cell a string value that you hope Excel will automatically interpret as a date and format as such. Cross fingers. Obviously this is not very robust. Or,
Write a numerical value to the cell from VBA (obviously a Date type is the intended type, but an Integer, Long, Single, or Double could do as well) and explicitly set the cells' number format to your desired date format using the .NumberFormat property (or manually in Excel). This is much more robust.
If you want to check that existing cell contents can be displayed as a date, then here's a function that will help:
Function CellContentCanBeInterpretedAsADate(cell As Range) As Boolean
Dim d As Date
On Error Resume Next
d = CDate(cell.Value)
If Err.Number <> 0 Then
CellContentCanBeInterpretedAsADate = False
Else
CellContentCanBeInterpretedAsADate = True
End If
On Error GoTo 0
End Function
Example usage:
Dim cell As Range
Set cell = Range("A1")
If CellContentCanBeInterpretedAsADate(cell) Then
cell.NumberFormat = "mm/dd/yyyy hh:mm"
Else
cell.NumberFormat = "General"
End If
Format converts the values to strings. IsDate still returns true because it can parse that string and get a valid date.
If you don't want to change the cells to string, don't use Format. (IOW, don't convert them to strings in the first place.) Use the Cell.NumberFormat, and set it to the date format you want displayed.
ActiveCell.NumberFormat = "mm/dd/yy" ' Outputs 10/28/13
ActiveCell.NumberFormat = "dd/mm/yyyy" ' Outputs 28/10/2013
Thanks for the input. I'm obviously seeing some issues that aren't being replicated on others machines. Based on Jean's answer I have come up with less elegant solution that seems to work.
Since if I pass the cell a value directly from cdate, or just format it as a number it leaves the cell value as a string I've had to pass the date value into a numerical variable before passing that number back to the cell.
Function CellContentCanBeInterpretedAsADate(cell As Range) As Boolean
Dim d As Date
On Error Resume Next
d = CDate(cell.Value)
If Err.Number <> 0 Then
CellContentCanBeInterpretedAsADate = False
Else
CellContentCanBeInterpretedAsADate = True
End If
On Error GoTo 0
End Function
Example usage:
Dim cell As Range
dim cvalue as double
Set cell = Range("A1")
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = cdate(cell.value)
cell.value = cvalue
cell.NumberFormat = "mm/dd/yyyy hh:mm"
Else
cell.NumberFormat = "General"
End If
Use value(cellref) on the side to evaluate the cells. Strings will produce the "#Value" error, but dates resolve to a number (e.g. 43173).
To ensure that a cell will return a date value and not just a string that looks like a date, first you must set the NumberFormat property to a Date format, then put a real date into the cell's content.
Sub test_date_or_String()
Set c = ActiveCell
c.NumberFormat = "#"
c.Value = CDate("03/04/2014")
Debug.Print c.Value & " is a " & TypeName(c.Value) 'C is a String
c.NumberFormat = "m/d/yyyy"
Debug.Print c.Value & " is a " & TypeName(c.Value) 'C is still a String
c.Value = CDate("03/04/2014")
Debug.Print c.Value & " is a " & TypeName(c.Value) 'C is a date
End Sub