VBA compare date from the inputbox with the date in the sheet - vba

I would like to use the date from inputbox , then compare it with the date in the excel sheet , so my code as below :
Sub test()
Dim date1 As Date
Date = InputBox("input the date ")
If date1 = Sheet3.Range("A2").Value Then
Debug.Print "TRUE"
Else
Debug.Print "FALSE"
End If
End Sub
the result it got is always "FALSE" in the immediate box although i have set the date match with the date inputted from inputbox , can you please assist on this case ? Any assist is appreciated.

The InputBox always returns a string, so convert this:
Sub test()
Dim Date1 As Date
Dim Value As String
Value = InputBox("Input the date")
If IsDate(Value) Then
Date1 = DateValue(Value)
If DateDiff("d", Date1, Sheet3.Range("A2").Value) = 0 Then
Debug.Print "TRUE"
Else
Debug.Print "FALSE"
End If
Else
Debug.Print "N/A"
End If
End Sub

A short solution, protected against the error of mismatching the type of input data and the data on the sheet (text or error instead of date in a cell)
Debug.Print IIf(InputBox("Input the date: ") = Sheet3.Range("A2").Text, "TRUE", "FALSE")

Related

vba inputbox maintenance on cancel

Im looking for a way to have inputbox pass only when I enter integer 1-12.
Any string in it, double value, empty or ESCAPE (cancel) button will throw Exit Sub
I know there is a lot of exmaples online, I tried them all! but always on ESCAPE or other occasion it get error.
so far I have this, but it gets error on CANCEL:
dMonth = InputBox("Which month to count?", "Choose month", Format(Date, "m") - 1)
If (Not (Int(dMonth) >= 0 And Int(dMonth) <= 12)) Or StrPtr(dMonth) = 0 Or StrPtr(dMonth) = 698279968 Or dMonth = "" Then Exit Sub
Any advice or ideas?
Thank you
Try this:
Private Sub Command1_Click()
Dim sMonth As String
Dim dMonth As Double
sMonth = InputBox("Which month to count?", "Choose month", Format(Date, "m") - 1)
dMonth = Val(sMonth) 'convert user input to numeric
If dMonth <> Fix(dMonth) Then Exit Sub 'check for an integer
If dMonth < 1 Or dMonth > 12 Then Exit Sub 'check for required range
MsgBox dMonth
End Sub

Relaunch Input Box

I have an excel sheet than when its first opened it asks the user to enter a date into the input box and it places it into a cell in the sheet. I have an error handle to pop up an invalid date error box if someone puts in the wrong date. But what I want to do is when an invalid date is entered the original input box for the date pops up again so they can reenter again. I have the code below of what I have written so far but I keep getting an error.
Thanks
ReShowInputBox: cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)")
On Error GoTo ErrHandle
ErrHandle:
MsgBox ("Invalid Date")
ReShowInputBox: cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)")
If cellvalue = "" Then Exit Sub
ws.Select
ws.Range("A1").Value = DateValue(cellvalue)
MsgBox ("Date Entered!")
How about a simple Do Until Loop:
Dim cellvalue As Variant
Do
cellvalue = Application.InputBox("Please Enter The Date for Data Extracted (dd/mm/yyyy)")
Loop Until IsDate(cellvalue) And IsNumeric(Right(cellvalue, 4)) And IsNumeric(Left(cellvalue, 2)) And IsNumeric(Mid(cellvalue, 4,2))
ws.Range("A1").Value = cellvalue
MsgBox ("Date Entered!")
I tested this pretty thoroughly and it only accepted dates in the exact format you desire.
Here is a simple way to repeatedly ask for a date until you get one, but allow the user to cancel out:
Sub fhskjfs()
Dim i As String, d As Date
i = ""
While Not IsDate(i)
i = Application.InputBox(Prompt:="Enter a date", Type:=2)
If i = False Then Exit Sub
If IsDate(i) Then d = CDate(i)
Wend
End Sub
EDIT#1:
Here is a way to implement a simple format check:
Public Function CheckFormat(i As String) As String
CheckFormat = "junk"
ary = Split(i, "/")
If UBound(ary) <> 2 Then Exit Function
If CLng(ary(2)) < 1900 Or CLng(ary(2)) > 9999 Then Exit Function
If CLng(ary(1)) > 12 Then Exit Function
If CLng(ary(0)) > 31 Then Exit Function
CheckFormat = i
End Function
Sub GetDate()
Dim i As String, d As Date
i = ""
While Not IsDate(i)
i = Application.InputBox(Prompt:="Enter a date", Type:=2)
If i = "False" Then Exit Sub
i = CheckFormat(i)
If IsDate(i) Then d = CDate(i)
Wend
End Sub

How to create an autoexecute macro in excel

I have a spreadsheet with data input by multiple users.
I would like to set up an autoexecute macro for all values in the spread sheet to be set to zero on the 15th and 30th of every month when users open the spreadsheet.
Please help.
This should do what you're after.
Private Sub Workbook_Open()
Dim dt As String
'GET THE CURRENT DAY OF MONTH
dt = Format(Now(), "DD")
'IF THE DATE IS 15th or 30th
If dt = "15" Or dt = "30" Then
'IF THE "DONE" VALUE IS BLANK
If Sheets(1).Range("XFD1").Value = "" Then
'CLEAR ALL CELLS IN SHEET 1
Sheets(1).Cells.Clear
'SET VALUE TO "DONE" SO THE MACRO KNOWS THE DATA WIPE HAS ALREADY BEEN PERFORMED
Sheets(1).Range("XFD1").Value = "DONE"
End If
End If
'IF THE DATE IS NOT 15TH OR 30TH, CLEAR THE "DONE" VALUE SO THE MACRO CAN RUN AGAIN THE NEXT TIME
If dt <> "15" And dt <> "30" Then
Sheets(1).Range("XFD1").Value = ""
End If
End Sub
Let me know if anything is unclear.

Reformat date from YYYY.MM.DD to DD/MM/YYYY

I import a date into an Excel sheet from a text file. The date has the form: YYYY.MM.DD.
I want to reverse the date so as to be: DD/MM/YYYY.
I have tried NumberFormat, Format and some other subroutines.
Here is the code:
Sub ImportRange()
Dim Filename As String
Dim Data
Dim Pos As Integer
On Error Resume Next
Filename = Application.DefaultFilePath & "\putty.log"
Open Filename For Input As #1
If Err <> 0 Then
MsgBox "Not found:" & Filename, vbCritical, "ERROR"
Exit Sub
End If
Application.ScreenUpdating = False
Line Input #1, Data
Close #1
Pos = InStr(Data, "log")
Sheets("ÐÉÓÔÏÐÏÉÇÔÉÊÏ").Range("B20").Value = Mid(Data, Pos + 4, 10)
Application.ScreenUpdating = True
End Sub
I have inserted a sample formula for the conversion let me know if this helps.
If cell A2 has the given date you can insert the given formula in B2
=DATE(VALUE(LEFT(A2,4)),VALUE(MID(A2,6,2)),VALUE(RIGHT(A2,2)))
Be sure that the actual cells that the dates are going in to formatted as a date

PR_LAST_VERB_EXECUTION_TIME

I have exported outlook email data to excel.
Now,another problem that I have come across is that the PR_LAST_VERB_EXECUTION_TIME do not display as the same date formats. The dates can be in ddmmyyyy hh:mm:ss AM/PM or mmddyyyy hh:mm format ( Please refer to the img ).
I have also made sure that all the cells format are general.Is it possible to standardize the date format or there might be any other reasons causing this?
my code is as follows:
For Each itm In Items
'Check item type
If TypeName(itm) = "MailItem" Then
intColumnCounter = 1
Set msg = itm
intRowCounter = intRowCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = GetLastVerb(msg)
End If
Next
Function GetLastVerb(olkMsg As Outlook.MailItem) As String
Dim intVerb As Integer
intVerb = GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x10810003")
Select Case intVerb
Case 102
Debug.Print ("Reply to Sender")
GetLastVerb = GetLastVerbTime(olkMsg)
Case 103
Debug.Print ("Reply to All")
GetLastVerb = GetLastVerbTime(olkMsg)
Case 104
Debug.Print ("Forward")
GetLastVerb = olkMsg.ReceivedTime
Case 108
Debug.Print ("Reply to Forward")
GetLastVerb = GetLastVerbTime(olkMsg)
Case Else
Debug.Print ("Unknown")
GetLastVerb = olkMsg.ReceivedTime
End Select
End Function
Public Function GetProperty(olkItm As Object, strPropName As String) As Date
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkItm.PropertyAccessor
GetProperty = olkPA.GetProperty(strPropName)
Set olkPA = Nothing
End Function
Function GetLastVerbTime(olkItm As Object) As Variant
GetLastVerbTime = GetDateProperty(olkItm, "http://schemas.microsoft.com/mapi/proptag/0x10820040")
End Function
Public Function GetDateProperty(olkItm As Object, strPropName As String) As Date
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkItm.PropertyAccessor
GetDateProperty = olkPA.UTCToLocalTime(olkPA.GetProperty(strPropName))
Set olkPA = Nothing
End Function
The reason behind it very simple
The function GetLastVerb calls other functions which return a Date or a variant and then finally GetLastVerb returns a string. The best way is to simply format the output before writing it to the range
If you are not concerned with the type of final output i.e whether it is a string or a date then replace rng.Value = GetLastVerb(msg) by rng.Value = Format(GetLastVerb(msg), "dd/mm/yyyy hh:mm:ss AM/PM")
If you want a proper date output then, format the column as relevant date/time format and then use formula to update the cell
For example
Columns("A:A").NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
rng.FormulaR1C1 = Format(GetLastVerb(msg), "dd/mm/yyyy hh:mm:ss AM/PM")