I wrote a procedure
Sub message()
Dim answer As Variant
answer = InputBox("Write something")
Range("A1").Select
ActiveCell.value = answer
MsgBox "You wrote: " & answer
End Sub
but when a user clicks "Cancel" it actually doesn't cancel, but clear the cell A1.
I tried something like this:
Sub message()
Dim answer As Variant
answer = Select Case InputBox("Write something")
Case vbOK
Range("A1").Select
ActiveCell.value = answer
MsgBox "You wrote: " & answer
End Sub
but it didn't work.
Here's the solution.
Sub message()
Dim answer As Variant
answer = InputBox("Write something")
If StrPtr(answer) = 0 Then ''if Cancel pressed
Exit Sub
Else ''if OK pressed
Range("A1").Value = answer
MsgBox "You wrote: " & answer
End If
End Sub
Related
I made a coding about calculation, there are 2 numbers in the 2 different 2 boxes, when I calculate the answer is wrong, there is a msgbox shown "Try again", if correct, the msgbox shown "you are correct", but is insert nothing or words then press enter, it will be shown error.
I want if the inputbox insert nothing then press enter, the inputbox will be shown again to restrick someone insert something into the inputbox and can not insert any words into the inputbox, if insert any words, also the inputbox will be shown again return to empty.
Does anyone can tell me how to solve this problem?
Thank you so much.
Dim a As String
Do While True
a = InputBox("Please enter your answer")
If a = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
Else
MsgBox("Try again!!!!")
End If
Loop
MsgBox("You are correct!")
End Sub
End Class
Dim a As String
Do While True
Do While a="" Or Not IsNumeric(a)
a = InputBox("Please enter your answer")
Done
If val(a) = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
Else
MsgBox("Try again!!!!")
End If
Loop
MsgBox("You are correct!")
InputBox in Do...Loop
Sub QnA()
Const Title As String = "Q&A"
Dim Answer As String
Dim TryAgain As Long
Do
Answer = InputBox("Please enter your answer", Title, "")
If Len(Answer) = 0 Then
MsgBox "Nothing entered.", vbExclamation, Title
Exit Sub
End If
If IsNumeric(Answer) Then
If Val(Answer) = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
End If
End If
TryAgain = MsgBox("Wrong answer (""" & Answer & """). Try again?", _
vbYesNo + vbQuestion, Title)
If TryAgain = vbNo Then Exit Sub
Loop
MsgBox "You are correct!", vbInformation, Title
End Sub
This question already has answers here:
Disable Excel save option but allow macro save
(2 answers)
Closed 5 years ago.
I am writing a code that will prevent the user from saving the workbook, and it will only save when I want it to. This is to prevent the user from making changes and saving when they are not supposed to. I have created two private subs, but I don't know how to make an exception when the workbook is being saved on my own. I would like to be able to place the saving code in various macros so that I can control the save at any point.
The following is my code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "You can't save this workbook!"
Cancel = True
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
myValue = InputBox("Please input your email address:", "Input", "x#us.tel.com")
'Place your text here
MyNote = "Is this correct?: " & myValue
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
If Answer = vbNo Then
'Code for No button Press
GoTo Line
Else
Range("A1").Value = myValue
End If
ActiveWorkbook.Save
End If
End Sub
You may try something like this...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Environ("UserName") <> "YourUserNameHere" Then
MsgBox "You can't save this workbook!"
Cancel = True
End If
End Sub
Edit:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Ans As VbMsgBoxResult
Ans = MsgBox("You can't save this workbook!" & vbNewLine & _
"Do you have password to save the file?", vbQuestion + vbYesNo)
If Ans = vbYes Then
frmPassword.Show 'UserForm to accept the password
Else
Cancel = True
End If
End Sub
I added a public variable saveLock that I reference in the save cancel code. This allows me to lock and unlock the save inside of my code. If anyone has a better way please let me know, but this did solve the problem.
Public saveLock As Integer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If saveLock = 0 Then
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
saveLock = 0
MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
myValue = InputBox("Please input your email address:", "Input", "x#us.tel.com")
'Place your text here
MyNote = "Is this correct?: " & myValue
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
If Answer = vbNo Then
'Code for No button Press
GoTo Line
Else
Range("A1").Value = myValue
End If
saveLock = 1
ActiveWorkbook.Save
saveLock = 0
End If
End Sub
this is my first post, please be patient if I'm doing/asking something wrong.
My issue is:
I got 2 columns, A is number of children, B is name of those children.
Those values are manually entered, I simply would like to have B mandatory if A is filled.
Here is what I thought:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(Sheet1.Range("A1")) Then
If IsEmpty(Sheet1.Range("B1")) Then
MsgBox "Please fill in cell B1 before closing."
Cancel = True
Else '
End If
End If
End Sub
This is actually working perfectly, unfortunately I can't manage to extend it for whole columns, when replacing A1 with A1:A1000 and B1 with B1:B1000 for instance,it doesn't work.
How can I validate this for both entire column A and B?
thanks in advance!
Try this
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Evaluate("SUMPRODUCT(--(ISBLANK(Sheet1!B:B) <> ISBLANK(Sheet1!A:A)))")
If Cancel Then MsgBox "Please fill in column B before closing."
End Sub
EDIT
In order to take the user to the place where data is missing, and taking into account the additional information you provided about your data, try this:
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r: r = Evaluate( _
"MATCH(FALSE, ISBLANK('ELENCO AGGIORNATO'!V:V) = ISBLANK('ELENCO AGGIORNATO'!W:W), 0)")
If IsError(r) Then Exit Sub ' All is fine
Cancel = True
Application.Goto Sheets("ELENCO AGGIORNATO").Cells(r, "V").Resize(, 2)
msgBox "Please fill missing data before saving."
End Sub
Also note that I recommend Workbook_BeforeSave instead of Workbook_BeforeClose, because there's no harm if the user decides to drop his (incomplete) work and close the workbook without saving.
You may try something like this...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim str As String
Dim Rng As Range, Cell As Range
Dim FoundBlank As Boolean
Set Rng = Sheet1.Range("A1:A1000")
str = "Please fill the cells listed below before colsing..." & vbNewLine & vbNewLine
For Each Cell In Rng
If Cell <> "" And Cell.Offset(0, 1) = "" Then
FoundBlank = True
str = str & Cell.Address(0, 1) & vbNewLine
End If
Next Cell
If FoundBlank Then
Cancel = True
MsgBox str, vbExclamation, "List of Blank Cells Found!"
End If
End Sub
I am trying to create a user form in VBA on Microsoft word.
I have been following http://gregmaxey.com/word_tip_pages/create_employ_userform.html
to create the form.
I am very very very new to programming and have basically just been teaching myself as I go.
I get a "compile error: Sub of Function not defined" when I try and step through Call UF
I've attached the whole code for you to look at and tell me where I've gone wrong, happy for any suggestions.
Module - modMain
Option Explicit
Sub Autonew()
Create_Reset_Variables
Call UF
lbl_Exit:
Exit Sub
End Sub
Sub Create_Reset_Variables()
With ActiveDocument.Variables
.Item("varFormNumber").Value = " "
.Item("varTitle").Value = " "
.Item("varGivenName").Value = " "
.Item("varFamilyName").Value = " "
.Item("varStreet").Value = " "
.Item("varSuburb").Value = " "
.Item("varState ").Value = " "
.Item("varPostCode").Value = " "
.Item("varInterviewDate").Value = " "
End With
myUpdateFields
lbl_Exit:
Exit Sub
End Sub
Sub myUpdateFields()
Dim oStyRng As Word.Range
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each oStyRng In ActiveDocument.StoryRanges
Do
oStyRng.Fields.Update
Set oStyRng = oStyRng.NextStoryRange
Loop Until oStyRng Is Nothing
Next
End Sub
Form - frmLetter13
Option Explicit
Public boolProceed As Boolean
Sub CalUF()
Dim oFrm As frmLetter13
Dim oVars As Word.Variables
Dim strTemp As String
Dim oRng As Word.Range
Dim i As Long
Dim strMultiSel As String
Set oVars = ActiveDocument.Variables
Set oFrm = New frmLetter13
With oFrm
.Show
If .boolProceed Then
oVars("varFormNumber").Value = TextBoxFormNumber
oVars("varTitle").Value = ComboBoxTitle
oVars("varGivenName").Value = TextBoxGivenName
oVars("varFamilyName").Value = TextBoxFamilyName
oVars("varStreet").Value = TextBoxStreet
oVars("varSuburb").Value = TextBoxSuburb
oVars("varState").Value = ComboBoxState
oVars("varPostCode").Value = TextBoxPostCode
oVars("varInterviewDate").Value = TextBoxInterviewDate
End If
Unload oFrm
Set oFrm = Nothing
Set oVars = Nothing
Set oRng = Nothing
lbl_Exit
Exit Sub
End Sub
Private Sub TextBoxFormNumber_Change()
End Sub
Private Sub Userform_Initialize()
With ComboBoxTitle
.AddItem "Mr"
.AddItem "Mrs"
.AddItem "Miss"
.AddItem "Ms"
End With
With ComboBoxState
.AddItem "QLD"
.AddItem "NSW"
.AddItem "ACT"
.AddItem "VIC"
.AddItem "TAS"
.AddItem "SA"
.AddItem "WA"
.AddItem "NT"
End With
lbl_Exit:
Exit Sub
End Sub
Private Sub CommandButtonCancel_Click()
Me.Hide
End Sub
Private Sub CommandButtonClear_Click()
Me.Hide
End Sub
Private Sub CommandButtonOk_Click()
Select Case ""
Case Me.TextBoxFormNumber
MsgBox "Please enter the form number."
Me.TextBoxFormNumber.SetFocus
Exit Sub
Case Me.ComboBoxTitle
MsgBox "Please enter the Applicant's title."
Me.ComboBoxTitle.SetFocus
Exit Sub
Case Me.TextBoxGivenName
MsgBox "Please enter the Applicant's given name."
Me.TextBoxGivenName.SetFocus
Exit Sub
Case Me.TextBoxFamilyName
MsgBox "Please enter the Applicant's family name."
Me.TextBoxFamilyName.SetFocus
Exit Sub
Case Me.TextBoxStreet
MsgBox "Please enter the street address."
Me.TextBoxStreet.SetFocus
Exit Sub
Case Me.TextBoxSuburb
MsgBox "Please enter the suburb."
Me.TextBoxSuburb.SetFocus
Exit Sub
Case Me.ComboBoxState
MsgBox "Please enter the state."
Me.ComboBoxState.SetFocus
Exit Sub
Case Me.TextBoxPostCode
MsgBox "Please enter the postcode."
Me.TextBoxPostCode.SetFocus
Exit Sub
Case Me.TextBoxInterviewDate
MsgBox "Please enter the interview date."
Me.TextBoxInterviewDate.SetFocus
Exit Sub
End Select
'Set value of a public variable declared at the form level.'
Me.boolProceed = True
Me.Hide
lbl_Exit:
Exit Sub
End Sub
There are a couple of issues here.
The first issue is that you do not have a routine named UF for Call UF to call.
The routine that you have named CalUF should not be in the code for the UserForm but should be in modMain and renamed CallUF.
There is no need to include an exit point in your routine as you don't have an error handler.
Your AutoNew routine could be rewritten as:
Sub Autonew()
Create_Reset_Variables
CallUF
End Sub
I have commented your sub myUpdateFields for you.
Sub myUpdateFields()
Dim oStyRng As Word.Range
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
' logically, iLink should be the StoryType of the first header in Section 1
' Why would this be needed in all StoryRanges?
' Anyway, it is never used. Why have it, then?
' This loops through all the StoryRanges
For Each oStyRng In ActiveDocument.StoryRanges
' This also loops through all the StoryRanges
Do
oStyRng.Fields.Update
Set oStyRng = oStyRng.NextStoryRange
Loop Until oStyRng Is Nothing
'And after you have looped through all the StoryRanges
' Here you go back and start all over again.
Next oStyRng End Sub
Frankly, I don't know if the Do loop does anything here. Perhaps it does. Read up about the NextStoryRange property here. I also don't know if using the same object variable in the inside loop upsets the outside loop. I don't know these things because I never needed to know them. Therefore I wonder why you need them on your second day in school.
You are setting a number of document variables. These could be linked to REF fields in your document which you wish to update. I bet your document has only one section, no footnotes and no textboxes with fields in them. Therefore I think that the following code should do all you need, if not more.
Sub myUpdateFields2()
Dim Rng As Word.Range
For Each Rng In ActiveDocument.StoryRanges
Rng.Fields.Update
Next Rng
End Sub
To you, the huge advantage of this code is that you fully understand it. Towards this end I have avoiding using a name like oStyRng (presumably meant to mean "StoryRange Object"). It is true that a Word.Range is an object. It is also true that the procedure assigns a StoryRange type of Range to this variable. But the over-riding truth is that it is a Word.Range and therefore a Range. Code will be easier to read when you call a spade a spade, and not "metal object for digging earth". My preferred variable name for a Word.Range is, therefore, "Rng". But - just saying. By all means, use names for your variables which make reading your code easy for yourself.
need help with the yes no portion of the error message, if yes I want the code to be launched again and if no then exit sub.
Public Sub Reset()
Dim pt As PivotTable
Dim slice As Slicer
Application.ScreenUpdating = False
ActiveWorkbook.Model.Refresh
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
For Each slice In pt.Slicers
slice.SlicerCache.ClearAllFilters
On Error GoTo 0
Next slice
pt.PivotCache.Refresh
Next pt
Error 0:
MsgBox "Sorry, Missing data, do you wish to continue?", _
vbCritical vbYesNo, "Restart process!"
Select Case vbYesNo
Case yes
MergeMultipleSheets
Case Else
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub
Here is yes no portion of your code (assuming that you want to launch module MergeMultipleSheets if yes button is clicked):
Sub Reset()
Dim xlAns As Integer
xlAns = MsgBox("Sorry, Missing data, do you wish to continue?", vbYesNo, "Restart process!")
Select Case xlAns
Case vbYes
' do something
' if You want to call sub MergeMultipleSheets
MergeMultipleSheets
Case Else
' do something
Exit Sub
End Select
End Sub
Quick Example
Sub MsgBx()
Dim xlMsgBox As Integer
Dim Cancel As Boolean
xlMsgBox = MsgBox("Do you want to do this ", vbYesNoCancel)
If xlMsgBox = vbCancel Then
Cancel = True ' Exit
Exit Sub
ElseIf xlMsgBox = vbYes Then
' do something
ElseIf xlMsgBox = vbNo Then
' do something
End If
End Sub