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
Related
I have a userform. The idea is to check if there are any 'True' values in column(15) in 'Admin' sheet. If there is at least a single 'True' value, then the userform will remain open and continue its operation.
However, if there is not a single 'True' found, then the userform will display a message and close the userform automatically.
Private Sub Userform_initialize()
Dim LR As Long
LR = Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row
With Worksheets("Admin")
For i = 7 To LR
If .Cells(i, 15) = "True" Then
Exit For
Else
MsgBox ("No values found")
Exit For
Unload Me
End If
Next i
End With
''' more code'''
End Sub
Everything on my userform works as expected, except for the fact I am unable to make it close itself automatically. I.e. Unload Me is not working.
Any advice?
You should check your criteria before you even display the UserForm. You can add this as a condition wherever you are calling the UserForm. No need to open the form just to immediately close it when you can check before-hand.
On the first instance of True, the UserForm will open, and exit the sub. If the loop completes (finds no True values), the sub will proceed to your MsgBox
Sub OpenForm
With Worksheets("Admin")
For i = 7 To LR
If Cells(i,15) = "True" then
Userform.Show
Exit Sub
End If
Next i
End With
MsgBox "No Values Found"
End Sub
Please look at your code; you have put Unload Me is after Exit For
'Here is something for you to ponder on .........
'Public enum type to add a set of particular vbKeys to the standard key set
Public Enum typePressKeys
vbNoKey = 0
vbExitTrigger = -1
vbAnswerKey = 100
vbLaunchKey = 102
vbPrevious = 104
vbNext = 106
vbSpecialAccessKey = 108
End Enum
Public Sub doSomethingWithMyUserform()
Dim stopLoop As Boolean, testVal As Boolean, rngX As Range, LR As Long
LR = ThisWorkbook.Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row
Set rngX = ThisWorkbook.Worksheets("Admin")
testVal = False
With rngX 'Your sub can do the check here
For i = 7 To LR
If .Cells(i, 15) = "True" Then
testVal = True
Exit For
End If
Next i
End With
If testVal Then
Load UserForm1
With UserForm1
.Caption = "Something"
.Tag = vbNoKey
.button_OK.SetFocus 'Assuming you have a OK button on Userform1
End With
UserForm1.Show
stopLoop = False
Do
If UserForm1.Tag = vbCancel Then
'Do something perhaps
Unload UserForm1
stopLoop = True
ElseIf UserForm1.Tag = vbOK Then
'Do something specific
Unload UserForm1
stopLoop = True
Else
stopLoop = False
End If
Loop Until stopLoop = True
else
MsgBox "No values found"
End If
'Here you can close the way you want
Set rngX = Nothing
End Sub
enter code here
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
I have the below code that will throw a prompt when a particular sheet is empty before saving the workbook.
Purpose of code: To check, if value of drop-down is "yes" in Main Sheet and if "yes", check if given range on a particular sheet is blank. If "yes", throw a prompt and change the drop down value to "No" on main sheet.
Concern: For loop in the code will check if any cell is empty in given range, instead, I want a code to check if there is an entry in any one cell in given range. Lets say given range is E10:G19, if we have an entry in E10, It should come out of the code and should not throw a prompt and should throw only if all the cells in given range is empty.
Question: What should replace my For loop that can serve my purpose?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
Exit For
Else: bOk = False
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
End If
End Sub
Here you go:
Option Explicit
Public Function b_is_range_empty(my_rng As Range)
If Application.WorksheetFunction.CountA(my_rng) > 0 Then
b_is_range_empty = False
Else
b_is_range_empty = True
End If
End Function
Public Sub TestMe()
Debug.Print b_is_range_empty(Selection)
End Sub
The idea is to use the built-in formula in Excel - CountA. It is optimized for faster search. In the test it works with selection of the area.
Edit:
In stead of this:
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
Exit For
Else: bOk = False
End If
Next
Write simply this:
bOK = b_is_range_empty(Rvalue)
Maybe you're after something like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If UCase(Worksheets("Main").Range("E29").Value) <> "YES" Then Exit Sub
If WorksheetFunction.CountA(Worksheets("Uni-corp").Range("E10:G19")) > 0 Then Exit Sub
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True '<--| this will make the macro not save the workbook
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell)<>true Then
bOk = false
Exit For
Else: bOk = true
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
If bOk=false Then
If MsgBox("Sheet is not blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "Yes"
Cancel = True
End If
End If
End If
End Sub
You appear to be exiting your for loop when the first cell is empty, you will want it to only exit when it finds a value instead:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")
If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
If IsEmpty(cell) Then
bOk = True
'Exit For moved to Else section
Else: bOk = False
Exit for
End If
Next
If bOk Then
If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
Worksheets("Main").Range("E29").Value = "NO"
Cancel = True
End If
End If
End If
End Sub
Hi I'm pretty new at the vba so please don't shoot my code :-).
I have a set of repaeting code's. I woukld like to simplify this code by using the code name with an increasing number. I can't get it to run. Can someone help me a bit on the road to get this going.
Below what I'm trying.
The second block is a part of the code now (it's 40 blocks of the same code only increasing the number)
Sub sheet41()
Dim i As Integer
Dim chkname As Integer
chkname = "SheetCheckBox" & i
i = 1
Do
i = i + 1
If chkname.Visible = False Then Exit Sub
If chkname.value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Loop Until i = ThisWorkbook.Worksheets.Count
End Sub
This is the old code:
Sub Sheet1()
If SheetCheckBox1.Visible = False Then Exit Sub
If SheetCheckBox1.value = True Then
Sheets("Item_1").Select
Call Finalize
End If
End Sub
Sub Sheet2()
If SheetCheckBox2.Visible = False Then Exit Sub
If SheetCheckBox2.value = True Then
Sheets("Item_2").Select
Call Finalize
End If
End Sub
Sub Sheet3()
If SheetCheckBox3.Visible = False Then Exit Sub
If SheetCheckBox3.value = True Then
Sheets("Item_3").Select
Call Finalize
End If
End Sub
As you can see this should be possible to clean I asume.
This should do it. If finalize isn't called on a worksheet then the reason why is printed to the Immediate Window.
Sub ProcessWorkSheets()
Dim check As MSForms.CHECKBOX
Dim i As Integer
For i = 1 To Worksheets.Count
On Error Resume Next
Set check = Worksheets(i).OLEObjects("SheetCheckBox" & i).Object
On Error GoTo 0
If check Is Nothing Then
Debug.Print Worksheets(i).Name; " - Checkbox not found"
Else
If check.Visible And check.Value Then
Worksheets(i).Select
Call Finalize
Else
Debug.Print Worksheets(i).Name; " - Checkbox", "Visible", check.Visible, "Value:", check.Value
End If
End If
Set check = Nothing
Next
End Sub
If the checkboxes on the Sheet are ActiveX Controls, you can use this to access the checkboxes:
Sheets("sheet1").OLEObjects("chkTest").Object
if you want to change the value of a checkbox, use it like this:
Sheets("sheet1").OLEObjects("chkTest").Object.Value = True
now replace "sheet1" with your actual sheet name and change the "chkTest" to your string chkname
So your complete code should be like this:
Dim i As Integer
Dim sheetname As String
Dim chkname As String
sheetname = "YOUR SHEETNAME HERE"
For i = 1 To ThisWorkbook.Worksheets.Count Step 1
chkname = "SheetCheckBox" & i
If Sheets(sheetname).OLEObjects(chkname).Object.Visible = False Then Exit Sub
If Sheets(sheetname).OLEObjects(chkname).Object.Value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Next i
#
updated codes
Function condition(ByRef objCmb As ComboBox)
If objCmb.Value ="" And objCmb.Value = "g" Then
Call MsgBox("gg", vbOKOnly, "error")
End If
End Function
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition (ComboBox1)
End Sub
'other codes for reference:
Private Sub CommandButton1_Click()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To 3
For j = 1 To 5
With Me.Controls("ComboBox" & (i - 1) * 5 + j)
If .Text <> "" Then
Cells(lastrow + i, j) = .Text
Else
Exit Sub
End If
End With
Next j
Next i
End Sub
I have 50 combo and text boxes in VBA user panel. As it is too troublesome to set constraints in every combo or text box, I want a function to apply to every combo and text box.
For the codes above , it shows up cant find objecterror
How to solve ?
Btw , how to set the function statement for textbox ?
is it Function condition2(ByRef objCmb As textbox)...
You are receiving an error because ComboBox is not ByRef objCmb As ComboBox. Don't use parenthesis when calling a sub. Don't use parenthesis when calling function if you are not using the functions return value. If a function does not return a value it should be a sub.
Sub condition(ByRef objCmb As MSForms.ComboBox)
If objCmb.Value <> "" And objCmb.Value = "g" Then
MsgBox "gg", vbOKOnly, "error"
objCmb.Value = ""
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I wrote a function to help you generate the Exit event code for all your text and combo boxes.
Sub AddCodeToCipBoard(frm As UserForm)
Const BaseCode = " Private Sub #Ctrl_Exit(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _
" condition ComboBox1" & vbCrLf & _
" End Sub" & vbCrLf & vbCrLf
Dim s As String
Dim ctrl
Dim clip As DataObject
Set clip = New DataObject
For Each ctrl In frm.Controls
If TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox" Then
s = s & Replace(BaseCode, "#Ctrl", ctrl.Name)
End If
Next
clip.SetText s
clip.PutInClipboard
End Sub
Put this code in a module and call it like this:
AddCodeToCipBoard Userform1
Now all the Exit event code will be copied into the Windows Clipboard. Go into your Userforms code module and paste the new code.
Example Output:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub