The question is how to make sure that if the entered value is empty (""), then exit the procedure, otherwise convert it to a numeric representation.
How to do it?
Sub macrotest()
Dim num As Integer
Dim text As String
num = InputBox("enter the number", "number input")
Select Case num Mod 100
Case 2, 4, 6, 8
MsgBox "even number" & num & ""
Case Else
MsgBox "idk" & num & ""
End Select
End Sub
InputBox feat. Mod
Option Explicit
Sub macrotest()
Dim cValue As Variant
Dim text As String
cValue = InputBox("enter the number", "number input")
If IsNumeric(cValue) Then
If cValue = CLng(cValue) Then ' if is whole number
If cValue Mod 2 = 0 Then
MsgBox "Even number " & cValue
Else
MsgBox "Odd number " & cValue
End If
' Select Case cValue Mod 10
' Case 0, 2, 4, 6, 8
' MsgBox "Even number " & cValue
' Case Else
' MsgBox "Odd number " & cValue
' End Select
Else
MsgBox "'" & cValue & "' is not a whole number.", _
vbExclamation, "Decimal Number"
End If
End If
End Sub
I modified your code a little to show how to test and convert user input:
Sub macrotest()
Dim num As Integer
Dim text As String
text = InputBox("enter the number", "number input")
If Not IsNumeric(text) Then Exit Sub
num = CInt(text)
Select Case num Mod 100
Case 2, 4, 6, 8
MsgBox "even number" & num & ""
Case Else
MsgBox "idk" & num & ""
End Select
End Sub
Related
I have a dataset, in which i want to delete every x row of it (x = userinput).
If i delete the rows immediately, the endresult will be incorrect because the row order changes with every deletion.
I wrote this code so far:
Sub Delete_Data()
'Take userinput
Dim userInput As Variant
Dim i As Long
Do While True
userInput = InputBox("please enter a number between 2-100", _
"Lets delete some data XD")
If IsNumeric(userInput) And userInput >= 2 _
And userInput <= 100 Then
Exit Do
End If
If MsgBox("Invalid Input, please redo or cancel", _
vbOKCancel, "Invalid input") = vbCancel Then Exit Do
Loop
'Delete Rows
Worksheets("Sheet1").Activate
For i = 2 To Rows.count Step userInput
If Rows.Cells(i, 1).Value = "" Then
Rows(ActiveCell.Row).EntireRow.Delete
MsgBox "you have successfully deleted every " _
& userInput & "th row!"
Exit For
Else
Rows(i).EntireRow.Select
End If
Next i
End Sub
The problem is that, the previous selection of a row disappears as soon as a new row gets selected. I hope you guys can help me out.
Using a union your code would look like this:
Sub Delete_Data()
'Take userinput
Dim userInput As Variant
Dim i As Long
Do While True
userInput = InputBox("please enter a number between 2-100", _
"Lets delete some data XD")
If IsNumeric(userInput) And userInput >= 2 _
And userInput <= 100 Then
Exit Do
End If
If MsgBox("Invalid Input, please redo or cancel", _
vbOKCancel, "Invalid input") = vbCancel Then Exit Do
Loop
'Delete Rows
With Worksheets("Sheet1")
Dim delrng As Range
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step userInput 'Change 2 to whatever column has the most data
If .Cells(i, 1).Value = "" Then
If delrng Is Nothing Then
Set delrng = .Cells(i, 1).EntireRow
Else
Set delrng = Union(delrng, .Cells(i, 1).EntireRow)
End If
End If
Next i
End With
delrng.Delete
Select Case True
Case Right(userInput, 1) = 1 And Not userInput = 11
MsgBox "you have successfully deleted every " _
& userInput & "st row!"
Case Right(userInput, 1) = 2 And Not userInput = 12
MsgBox "you have successfully deleted every " _
& userInput & "nd row!"
Case Right(userInput, 1) = 3 And Not userInput = 13
MsgBox "you have successfully deleted every " _
& userInput & "rd row!"
Case Else
MsgBox "you have successfully deleted every " _
& userInput & "th row!"
End Select
End Sub
I expanded your Msgbox to properly concatenate based on the number.
Thanks for your inputs:
thats the final code
Option Explicit
Sub Delete_Data()
'Take userinput
Dim userInput As Variant
Dim i As Long
Do While True
userInput = InputBox("please enter a number between 2-100", _
"Lets delete some data XD")
If IsNumeric(userInput) And userInput >= 2 _
And userInput <= 100 Then
Exit Do
End If
If MsgBox("Invalid Input, please redo or cancel", _
vbOKCancel, "Invalid input") = vbCancel Then Exit Sub
Loop
'Activate rows "to be deleted"
With Worksheets("Sheet1")
Dim delRange As Range
For i = 2 To .Cells(.Rows.count, 2).End(xlUp).Row Step userInput
If .Cells(i, 1).Value = "" Then
Exit For
ElseIf delRange Is Nothing Then
Set delRange = .Cells(i, 1).EntireRow
Else
Set delRange = Union(delRange, .Cells(i, 1).EntireRow)
End If
Next i
End With
'Mark rows "to be deleted"
delRange.Interior.ColorIndex = 6
'Ask for deltetion cofirmation
Dim answer As Variant
answer = MsgBox("Do you really want to delete the selected rows?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Confirm deletion")
If answer = vbYes Then
delRange.Delete
Else
delRange.Interior.ColorIndex = xlNone
Exit Sub
End If
'Give feedback to user & look for correct english wording
Select Case True
Case Right(userInput, 1) = 1 And Not userInput = 11
MsgBox "you have successfully deleted every " _
& userInput & "st row!"
Case Right(userInput, 1) = 2 And Not userInput = 12
MsgBox "you have successfully deleted every " _
& userInput & "nd row!"
Case Right(userInput, 1) = 3 And Not userInput = 13
MsgBox "you have successfully deleted every " _
& userInput & "rd row!"
Case Else
MsgBox "you have successfully deleted every " _
& userInput & "th row!"
End Select
End Sub
I just joined and hope to learn all I can here and contribute where I can.
I am having major issues with the last three sections of my VBA script.
The correct, incorrect, and percentage score values are not being displayed on slides 40 & 41.
On slide 42 I cannot get the textbox or the label to display the username, date and their overall percentage score.
Any help on slide 40 would be great and I can workout the rest.
**Sub shapeTextHappySmile()**strong text**
Sub ShapeTextSadSmile()
Sub CertificateBuld()**
Option Explicit
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
Private Sub CertDate()
Dim Rdate As Variant
Rdate = Date
Rdate = Format((Date), "mmmm dd, yyyy")
End Sub
Sub Initialise()
numberCorrect = 12
numberIncorrect = 8
numberPercentage = 58
numberTotal = 20
numberTotal = (numberCorrect + numberIncorrect)
numberCorrect = (numberTotal - numberIncorrect)
numberIncorrect = (numberTotal - numberCorrect)
numberPercentage = Round(numberCorrect / numberTotal) * 100
End Sub
Sub TakeQuiz()
UserName = InputBox(Prompt:="Type Your Name! ")
MsgBox "Welcome To The Academic Online Tutorial Quiz " + UserName, vbApplicationModal, " Academic Online Tutorial Quiz"
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Correct()
numberCorrect = numberCorrect + 1
MsgBox ("Great well Done! That's the correct answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Incorrect()
numberIncorrect = numberIncorrect + 1
MsgBox ("Sorry! That was the incorrect answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub shapeTextHappySmile()
ActivePresentation.Slides(40).Shapes(Label1).TextFrame.TextRange.Text = 12
'numberCorrect
ActivePresentation.Slides(40).Shapes(Label2).TextFrame.TextRange.Text = numberPercentage & "%"
MsgBox "Great Job, Well done " + "," & "Please print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, you can exit the presentation"
With SlideShowWindows(1).View
.GotoSlide 42
End With
End Sub
Sub ShapeTextSadSmile()
ActivePresentation.Slides(41).Shapes("AnsweredIncorrectly").TextFrame.TextRange.Text = numberIncorrect
ActivePresentation.Slides(41).Shapes("InCorrectPercentage").TextFrame.TextRange.Text = numberPercentage & " %"
MsgBox "Your score was below 70%, in order to pass the quiz and receive a certificate of completion you need to score 70% or more."
MsgBox "Please retake the quiz, and good luck"
With SlideShowWindows(1).View
.GotoSlide 1
End With
' I will add the option of redoing the entire presentation or just the quiz.
'see slide 19 action buttons
End Sub
Sub CertificateBuld()
MsgBox "Great Job, Well done " + "," & "Plese print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, please exit the presentation"
If numberCorrect >= "14" Then
ActivePresentation.Slides(42).Shapes(" ABCDEFGHIJKLMN ").TextFrame.TextRange.Text = " ABCDEFGHIJKLMN "
ActivePresentation.Slides(42).Shapes("Rdate & Percentage").TextFrame.TextRange.Text = " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
ActivePresentation.Slides(42).Shapes(UserName).TextFrame.TextRange.Text = UserName
'OR
If numberCorrect <= "14" Then
ActivePresentation.Slides(42).Shapes(8).TextFrame.TextRange.Text = ABCDEFGHIJKLMN "
ActivePresentation.Slides(42).Shapes(9).TextFrame.TextRange.Text = Rdate & " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
ActivePresentation.Slides(42).Shapes(10).TextFrame.TextRange.Text = UserName
Else
ActivePresentation.SlideShowWindow.View.Save
ActivePresentation.SlideShowWindow.View.Exit
End If
End Sub
See comments inline:
Sub shapeTextHappySmile()
' This won't work:
'ActivePresentation.Slides(40).Shapes(Label1).TextFrame.TextRange.Text = 12
' Shapes have names that are strings, so you need to use .Shapes("Label1")
' Assuming this is an ActiveX label, you get at its properties a bit
' differently from regular PPT shapes, starting with:
' .Shapes("Label1").OLEFormat.Object
' And for a Label ActiveX control, the property you want is .Caption
' And finally, Text/Caption properties take a String value so you want to
' put the 12 in quotes or convert a numeric value to string using Cstr(x)
' Final version:
ActivePresentation.Slides(40).Shapes("Label1").OLEFormat.Object.Caption = "12"
'numberCorrect
' And make the same changes to this one:
ActivePresentation.Slides(40).Shapes(Label2).TextFrame.TextRange.Text = numberPercentage & "%"
' MsgBox "Great Job, Well done " + "," & "Please print a copy of your completion certificate"
' and I think you probably want to do this instead of the above:
MsgBox "Great Job, Well done" & ", " & "Please print a copy of your completion certificate"
MsgBox "After printing or saving a copy of your certificate, you can exit the presentation"
With SlideShowWindows(1).View
.GotoSlide 42
End With
End Sub
Basic setup is, there are 2 textboxes and 1 calendar (Datepicker).
In textbox1, user enter date in either of the format mentioned below, press enter, date
gets selected on the calendar.
03-Feb
03-Feb-17
03-Feb-17
In textbox2, user enter days that needs to be added or subtracted as below, press enter,
date gets selected on the calendar.
+1, +15, +32... and so on to add days
-1, -12, -21... and so on to subtract days
Textbox1 code below works fine -
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim txt As String, dayStr As String, monthStr As String, yearStr As String
Dim okTxt As Boolean
txt = Me.TextBox1.Value
Select Case Len(txt)
Case 2
dayStr = txt
okTxt = okDay(dayStr)
monthStr = Month(Now)
yearStr = Year(Now)
Case 5
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
yearStr = Year(Now)
Case 7
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
yearStr = Mid(txt, 6, 2)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
End Select
If Not okTxt Then
MsgBox "Invalid date" _
& vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
& vbCrLf & vbTab & "dd" _
& vbCrLf & vbTab & "ddmmm" _
& vbCrLf & vbTab & "ddmmmyy" _
& vbCrLf & vbCrLf & "Please try again", vbCritical
Cancel = True
Else
Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
End If
End Sub
Function okDay(txt As String) As Boolean
okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function
Function okMonth(txt As String) As Boolean
Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
okMonth = InStr(months, UCase(txt)) > 0
End Function
Function okYear(txt As String) As Boolean
okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function
Textbox2 code below is where I need assistance -
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Ln As Variant
Dim x As Variant
Dim d As Variant
Dim fmt As Variant
If IsNumeric(Left(TextBox1, 2)) Then Ln = 0 Else Ln = 1
x = Left(TextBox2.Value, 1)
If x <> "-" And x <> "+" Then MsgBox "Please use an operator with your value":: Exit Sub
d = TextBox1.Value
Select Case Len(d)
Case 4, 5
d = Left(d, 2 - Ln) & "-" & Right(d, 3)
fmt = "ddmmm"
Case 6, 7
d = Left(d, 2 - Ln) & "-" & Mid(d, 3 - Ln, 3) & "-" & Right(d, Len(d) - (5 - Ln))
fmt = "ddmmmyy"
Case 8, 9
d = Left(d, 2 - Ln) & "-" & Mid(d, 3 - Ln, 3) & "-" & Right(d, Len(d) - (5 - Ln))
fmt = "ddmmmyyyy"
End Select
MsgBox Format(CDate(d) + Val(TextBox2.Value), fmt)
End Sub
Currently what is happening is -
User enter days that needs to added or subtracted in textbox2, press enter, a messagebox
appears showing the end result.
Rather than a messagebox, I simply want the code to select the end result on the calendar.
I'm not sure how to change textbox2 code to achieve this.
Kindly assist.
Note : Just like textbox1, where the code selects the date on calendar, I want textbox2 code to do the same, which is select date on calendar after days are added or subtracted.
substitute:
MsgBox Format(CDate(d) + Val(TextBox2.Value), fmt)
with:
Me.Calendar1.Value = CDate(d) + Val(TextBox2.Value)
I have a code that allows me to manually enter date in textbox1 which then gets selected in the calendar on the useform. There is a second textbox that allows me to add or subtract dates. The code works perfectly.
Userform Code -
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox1.Value) Then Me.Calendar1.Value = Me.TextBox1.Value
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date
With Me
If IsDate(.TextBox1.Value) Then
dt = CDate(.TextBox1.Value) + Val(.TextBox2.Value)
.TextBox1.Value = dt
.Calendar1.Value = dt
End If
End With
End Sub
I would like to manually enter date in textbox1 in a specific format.
The formats will be -
dd
ddmmm
ddmmmyyy
I'm not sure how to write a code that does this.
The idea is to enter date in either of the 3 formats specified above in textbox1, which then gets selected on the calendar on the userform.
edited after op's clarification about allowed formats
you could build upon the following code
Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim txt As String, dayStr As String, monthStr As String, yearStr As String
Dim okTxt As Boolean
txt = Me.TextBox1.Value
Select Case Len(txt)
Case 2
dayStr = txt
okTxt = okDay(dayStr)
monthStr = month(Now)
yearStr = year(Now)
Case 5
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
yearStr = year(Now)
Case 7
dayStr = Mid(txt, 3, 3)
monthStr = Mid(txt, 3, 3)
yearStr = Mid(txt, 6, 2)
okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
End Select
If Not okTxt Then
MsgBox "Invalid date" _
& vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
& vbCrLf & vbTab & "dd" _
& vbCrLf & vbTab & "ddmmm" _
& vbCrLf & vbTab & "ddmmmyy" _
& vbCrLf & vbCrLf & "Please try again", vbCritical
Cancel = True
Else
Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
End If
End Sub
Function okDay(txt As String) As Boolean
okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function
Function okMonth(txt As String) As Boolean
Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
okMonth = InStr(months, UCase(txt)) > 0
End Function
Function okYear(txt As String) As Boolean
okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function
Hi I am new of VBA programming
and I am trying to do search look up,
yes I can search single data but if the search count is >1 then I need to
do a msgbox that will appear based on how many times the string exist
and I got this result:
Yes I got the exact result but its only good for the first row of lookup
how about the next row which contains Salary: 234,871 and SSN of 241-652?
I guess I need to loop according to vlookup count but how to do it?
I need to see 2x MsgBox since it has two entries so when I click first msgbox ok
then the other one will follow .. Please help Thanks!
this is my code
Private Sub CommandButton2_Click()
On Error GoTo MyErrorHandler:
Dim E_name As String
E_name = InputBox("Enter the Employee Name :")
If Len(E_name) > 0 Then
For i = 1 To 3
Sal = Application.WorksheetFunction.VLookup(E_name, Sheets("sample").Range("B3:D8"), 3, False)
SSN = Application.WorksheetFunction.VLookup(E_name, Sheets("sample").Range("B3:D8"), 2, False)
MsgBox "Salary is : $ " & Sal & Chr(13) & "SSN is : " & SSN
Next i
Else
MsgBox ("You entered an invalid value")
End If
Exit Sub
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Employee Not Present in the table."
End If
End Sub
This is how I would do it:
Private Sub CommandButton2_Click()
Dim E_name As String
E_name = InputBox("Enter the Employee Name :")
If Len(E_name) > 0 Then
lastRow = Range("C65000").End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 2) = E_name Then
found = 1
MsgBox "Salary is : $ " & Cells(i, 4) & Chr(13) & "SSN is : " & Cells(i, 3)
End If
Next i
If found <> 1 Then MsgBox "Employee Not Present in the table."
Else
MsgBox ("You entered an invalid value")
End If
End Sub
This will also work.
Private Sub CommandButton2_Click()
Dim E_name, salary, ssn As String
Dim row As Integer
E_name = InputBox("Enter the Employee Name :")
'Set the start row
row = 3
If Len(E_name) > 0 Then
'Do until the name colum is blank
Do While Sheets("sample").Range("B" & row) <> ""
'If name are equal, show message box
If E_name = Sheets("sample").Range("B" & row) Then
salary = Sheets("sample").Range("D" & row)
ssn = Sheets("sample").Range("C" & row)
MsgBox "Salary is : $ " & salary & Chr(13) & "SSN is : " & ssn
End If
'Increase row
row = row + 1
Loop
Else
MsgBox ("You entered an invalid value")
End If
End Sub