I am using an ElseIf statement and the systems date to create an output.
Here is my code so far:
Dim dateToday As Date
Dim fifth As Integer
Dim fifthteenth As Integer
Dim twentyEighth As Integer
Dim thirtieth As Integer
dateToday = Today
fifth = 5
fifthteenth = 17 'this is changed to todays date for testing otherwise its 15
twentyEighth = 28
thirtieth = 30
If fifth = dateToday Then
MsgBox ("Today is the fifth")
ElseIf fifthteenth = dateToday Then
MsgBox ("Today is the fifthteenth")
ElseIf twentyEighth = dateToday Then
MsgBox ("Today is the 28th")
ElseIf thirtieth = dateToday Then
MsgBox ("Today is the 30th")
Else
MsgBox ("You do not need to do anything yet")
End If
It is going straight to the end and produces the last message box.
Today is a worksheet function, not a VBA function - you want Date:
dateToday = Date
then you actually want to test against Day(dateToday) not just dateToday
Related
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")
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
I'm now trying to write an IF statement to say something to the effect of: If file is more than 5 days old, do not run macro. If more than 5 days old, run macro.
I would like to this to be a yes or no dialogue box. Here is my code. Please help. I'm still trying to learn this vba code.
Sub LastModifiedFile()
'Function FileLastModified(strFullFileName As String)
Dim fs As Object, f As Object, s As String, dtmodpath As String
dtmodpath = "\\jdshare\pdcmaterials\5_Tools\FTP\Cancelled_Report.txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(dtmodpath)
's = UCase(strFullFileName) & vbCrLf
s = f.DateLastModified
FileLastModified = s
Set fs = Nothing: Set f = Nothing
Range("E5").Value = FileLastModified
'If FileExists(strFullName) Then
'MsgBox FileLastModified(strFullName)
'Else
'MsgBox "File Older than 5 Years : " & vbNewLine & strFullName
'End If
'End Function
End Sub
Congrats for using correctly the .DateLastModified property!
Instead of the MsgBox-es call a function. The DateAdd() returns date, which is 5 days before the current date, thus it is easy to compare. This shows a MsgBox() which informs whether the file has more or less than 5 days from the last modification:
Option Explicit
Sub LastModifiedFile()
Dim fileObject As Object
Dim file As Object
Dim modPath As String
modPath = "\\jdshare\pdcmaterials\5_Tools\FTP\Cancelled_Report.txt"
Set fileObject = CreateObject("Scripting.FileSystemObject")
Set file = fileObject.GetFile(modPath)
If DateAdd("d", -5, Now) < file.DateLastModified Then
MsgBox "Less than 5 days."
Else
MsgBox "More than 5 days."
End If
End Sub
If you want to put a MsgBox in the whole story with Yes and No, then this should be ok:
Sub LastModifiedFile()
Dim fileObject As Object
Dim file As Object
Dim modPath As String
modPath = "\\jdshare\pdcmaterials\5_Tools\FTP\Cancelled_Report.txt"
Set fileObject = CreateObject("Scripting.FileSystemObject")
Set file = fileObject.GetFile(modPath)
Dim msgBoxStatement As String
If DateAdd("d", -5, Now) < file.DateLastModified Then
msgBoxStatement = "This file is NOT older than 5 days!" & vbCrLf & _
"Should it be deleted?"
Else
msgBoxStatement = "This file is older than 5 days!" & vbCrLf & _
"Should it be deleted?"
End If
Select Case MsgBox(msgBoxStatement, vbYesNo Or vbQuestion, "Delete?")
Case vbYes
'run the for deletion
Case vbNo
'do not run the code for deletion
End Select
End Sub
Use DateDiff function to compute your number of days.
Its not totally clear what you want to do with your Yes/No message box, here's an attempt :
Sub LastModifiedFile()
Dim fs As Object, f As Object, s As String, dtmodpath As String
Dim dtLastMod As Date
Dim intDays As Long
dtmodpath = "\\jdshare\pdcmaterials\5_Tools\FTP\Cancelled_Report.txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(dtmodpath)
dtLastMod = f.DateLastModified
' Here you compute the number of days between the file last mod date, and the current date
intDays = DateDiff("d", dtLastMod, Now)
Set fs = Nothing: Set f = Nothing
Range("E5").Value = dtLastMod
If intDays > 5 Then
If MsgBox("File is " & intDays & " days old, proceed with macro ?", vbYesNo, "Continue?") = vbYes Then
' RUN MACRO GOES HERE
End If
Else
MsgBox "File is " & intDays & " days old, cancelling"
End If
End Sub
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
I am relatively new to VBA and so I'm sure this is a basic mistake that I am making!
A1 contains valid date, A2 contains task information, A3 contains number of days before A1 date to trigger task reminder.
The problem is when I put =addtotasks(A1,A2,A3)
It just comes up with #NAME?
I have enabled the Microsoft Outlook 14.0 Object Library in the references.
I am based in the UK telling you for dates purposes.
This is the following code. I have included some extra code for setting a remainder only on a business day.
'Function NextBusinessDay(dateFrom As Date, _
Optional daysAhead As Long = 1) As Date
Dim currentDate As Date
Dim nextDate As Date
' convert neg to pos
If daysAhead < 0 Then
daysAhead = Abs(daysAhead)
End If
' determine next date
currentDate = dateFrom
nextDate = DateAdd("d", daysAhead, currentDate)
' is next date a weekend day?
Select Case Weekday(nextDate, vbUseSystemDayOfWeek)
Case vbSunday
nextDate = DateAdd("d", 1, nextDate)
Case vbSaturday
nextDate = DateAdd("d", 2, nextDate)
End Select
NextBusinessDay = CDate(Int(nextDate))
End Function
Dim bWeStartedOutlook As Boolean
Function AddToTasks(strDate As String, strText As String, DaysOut As Integer) As Boolean
' Adds a task reminder to Outlook Tasks a specific number of days before the date specified
' Returns TRUE if successful ' Will not trigger OMG because no protected properties are accessed
'
' Usage:
' =AddToTasks("12/31/2008", "Something to remember", 30)
' or:
' =AddToTasks(A1, A2, A3)
' where A1 contains valid date, A2 contains task information, A3 contains number of days before A1 date to trigger task reminder '
' can also be used in VBA :
'If AddToTasks("12/31/2008", "Christmas shopping", 30) Then
' MsgBox "ok!"
'End If
Dim intDaysBack As Integer
Dim dteDate As Date
Dim olApp As Object 'Outlook.Application
Dim objTask As Object ' Outlook.TaskItem
' make sure all fields were filled in
If (Not IsDate(strDate)) Or (strText = "") Or (DaysOut <= 0) Then
AddToTasks = False
GoTo ExitProc
End If
' We want the task reminder a certain number of days BEFORE the due date
' ex: if DaysOut = 120, then we want the due date to be -120 before the date specified
' we need to pass -120 to the NextBusinessDay function, so to go from 120 to -120,
' we subtract double the number (240) from the number provided (120).
' 120 - (120 * 2); 120 - 240 = -120
intDaysBack = DaysOut - (DaysOut * 2)
dteDate = NextBusinessDay(CDate(strDate), intDaysBack)
On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0
If Not olApp Is Nothing Then
Set objTask = olApp.CreateItem(3) ' task item
With objTask
.StartDate = dteDate
.Subject = strText & ", due on: " & strDate
.ReminderSet = True
.Save
End With
Else
AddToTasks = False
GoTo ExitProc
End If
' if we got this far, it must have worked
AddToTasks = True
ExitProc:
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function
I have taken this code from this website, by the way:
http://www.jpsoftwaretech.com/get-previous-business-day-in-vba/
The #Name? error happens when you reference a function or variable unknown to the program. It's not sure where this function resides. Try using the "fx" button next to the formula bar and selecting user defined functions, it should be listed there.
My guess is you created this function in a different work book probably the personal.xlsb.
In order to use user defined functions you have to reference the full path to them. Try reading the last paragraph here:
http://office.microsoft.com/en-us/excel-help/creating-custom-functions-HA001111701.aspx