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
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")
I have a report that is imported into excel every day, and the last column of information "Z", is all of the comments that have been left by previous agents working on the account. I am only interested in the last comment, but it can be of any length, so i cant just grab x amount of characters.
Question: Is there a way to only pull the last comment based on the criteria of the comment? (every comment ends with the username, date, and time-stamp:
Example of a cell:
Example of agent1 comment. [USERNAME1-xx/xx/xxxx xx:xx:xx PM] - Example of agent2 comment. [USERNAME2-xx/xx/xxxx xx:xx:xx PM])
In this scenario, the only text that i would want in the cell would be: "Example of agent2 comment.".
For the record, all of the imported report starts on "A2".
Guess I shouldn't do this as you haven't shown what you've tried yet, but this code should do the trick.
Enter in a cell: =ExtractLastComment(H3) where H3 contains the comment.
'Use this procedure to run on a range of cells.
'The result is placed one cell to the right of the comment: "Offset(, 1)"
Public Sub CommentsInColumn()
Dim rTarget As Range
Dim rCell As Range
Set rTarget = ThisWorkbook.Worksheets("Sheet1").Range("A2:A30")
For Each rCell In rTarget
rCell.Offset(, 1) = ExtractLastComment(rCell)
Next rCell
End Sub
Public Function ExtractLastComment(Target As Range) As Variant
Dim sCommentText As String
If HasComment(Target) Then
'Get the comment text.
sCommentText = Target.Comment.Text
If InStrRev(sCommentText, "[") <> 0 Then
'Find the last open bracket and take everything to the left of it.
sCommentText = Trim(Left(sCommentText, InStrRev(sCommentText, "[") - 1))
'Any closing brackets left?
If InStrRev(sCommentText, "]") <> 0 Then
'Take everything from last closing bracket to end of text.
sCommentText = Mid(sCommentText, InStrRev(sCommentText, "]") + 4)
End If
ExtractLastComment = sCommentText
Else
ExtractLastComment = CVErr(xlErrValue)
End If
Else
'There isn't a comment in the cell, return a !#NULL error.
ExtractLastComment = CVErr(xlErrNull)
End If
End Function
Public Function HasComment(Target As Range) As Boolean
On Error GoTo ERROR_HANDLER
If Target.Cells.Count = 1 Then
With Target
HasComment = Not .Comment Is Nothing
End With
Else
Err.Raise 513, "HasComment()", "Argument must reference single cell."
End If
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure HasComment."
Err.Clear
Application.EnableEvents = True
End Select
End Function
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 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
I sometimes have to enter a lot of dates in Excel spreadsheets. Having to enter the slashes slows things down a lot and makes the process more error prone. On many database programs, it is possible to enter the dates using only the numbers.
I have written a SheetChange event handler that lets me do this when entering dates in cells formatted as dates, but it fails if I copy a date from one location to another. If I could determine when an entry has been copied as opposed to entered, I could handle the two cases separately, but I have not been able to determine this yet.
Here is my code, but before you look at it, be aware that the last section handles inserting a decimal point automatically and it seems to be working ok. Finally, I added some variables (sValue, sValue2, etc.) to make it a little easier for me to track the data.
Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Application
End Sub
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim s As String
Dim sFormat As String
Dim sValue As String
Dim sValue2 As String
Dim sFormula As String
Dim sText As String
Dim iPos As Integer
Dim sDate As String
On Error GoTo ErrHandler:
If Source.Cells.Count > 1 Then
Exit Sub
End If
If InStr(Source.Formula, "=") > 0 Then
Exit Sub
End If
sFormat = Source.NumberFormat
sFormula = Source.Formula
sText = Source.Text
sValue2 = Source.Value2
sValue = Source.Value
iPos = InStr(sFormat, ";")
If iPos > 0 Then sFormat = Left(sFormat, iPos - 1)
If InStr("m/d/yy|m/d/yyyy|mm/dd/yy|mm/dd/yyyy|mm/dd/yy", sFormat) > 0 Then
If IsDate(Source.Value2) Then
Exit Sub
End If
If IsNumeric(Source.Value2) Then
s = CStr(Source.Value2)
If Len(s) = 5 Then s = "0" & s
If Len(s) = 6 Then
s = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Right(s, 2)
App.EnableEvents = False
If IsDate(s) Then Source.Value = s 'else source is unchanged
App.EnableEvents = True
End If
If Len(s) = 7 Then s = "0" & s
If Len(s) = 8 Then
s = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Right(s, 4)
App.EnableEvents = False
If IsDate(s) Then Source.Value = s 'else source is unchanged
App.EnableEvents = True
End If
End If
End If
If InStr(sFormat, "0.00") > 0 Then
If IsNumeric(Source.Formula) Then
s = Source.Formula
If InStr(".", s) = 0 Then
s = Left(s, Len(s) - 2) & "." & Right(s, 2)
App.EnableEvents = False
Source.Formula = CDbl(s)
App.EnableEvents = True
End If
End If
End If
ErrHandler:
App.EnableEvents = True
End Sub
Do you know how I can get this to work for copied dates as well as edited dates? Thanks for your help.
Actually, the event Worksheet_Change is called when copy/pasting, so it should work.
Just tested with:
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Test"
End Sub