I'm trying to ensure that for each row in my spreadsheet, if cell B or C is not populated (in the range), then a message box alerts the user - and doesn't allow it to be saved.
I have the workbook saved as a Macro enabled (XLSM) file - but the Workbook_BeforeSave doesn't appear to be triggering.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rng1 As Range
Dim rng2 As Range
MsgBox "hi"
Set rng1 = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(3, 4)).Select
Stop
'turn off events to avoid code retriggering itself
Application.EnableEvents = False
For Each rng2 In rng1
If Cells(rng2.Row, "B") = vbNullString Then
MsgBox "Please Enter Something in Cell B - your entry will be deleted", vbOKOnly
rng2.Value = vbNullString
End If
If Cells(rng2.Row, "C") = vbNullString Then
MsgBox "Please Enter Something in Cell C - your entry will be deleted", vbOKOnly
rng2.Value = vbNullString
End If
Next
Application.EnableEvents = True
End Sub
Can anyone see where I may have gone wrong? Macros are enabled for the workbook.
Thanks for any advice,
Mark
Somehow in your code, you have disabled the events, thus the Save event is not caught. Try the following:
Press Ctrl + G, while you are selecting the Visual Basic Editor;
Write Application.EnableEvents = True on the Immediate window that shows up;
Press Enter;
Now the events would be activated.
As mentioned by Jeep, using error handling is a good idea in this case, thus the events are always enabled back if something "bad" happens during code execution:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo Workbook_BeforeSave_Error
'code here
On Error GoTo 0
Exit Sub
Workbook_BeforeSave_Error:
Application.EnableEvents = True
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Workbook_BeforeSave"
End Sub
Related
I need some assistance with BeforeSave VBA event.
I've introduced an additional criteria using Conditional Formatting to highlight a cell if it does not equal 10 characters.
Issue is, I already have a BeforeSave event in VBA to check if a checkbox is checked, how can I combine these two statements so that it checks these two criteria before saving?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In Worksheets(1).UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
MsgBox ("Please correct any fields highlighted in red")
Exit For
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions before saving the Invoice"
End Sub
The highlighted criteria is the one I used to evaluate the checkbox, in between is the code I'm attempting to check for any cells filled in red. Also a sample in an excel sheet.
Thanks for the help!
You were close! A couple changes:
You need to check against the cell's .DisplayFormat since that is conditional formatting.
You were exiting your subroutine before getting to your If condition. Use Exit For instead.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
Cancel = True
Exit For
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions"
End Sub
Also Application.ScreenUpdating = True needs to be outside your loop, otherwise it may never be turned back on!
UPDATE:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Cancel = Not Worksheets(1).CheckBoxes(1).Value = 1
Dim rng As Range
For Each rng In Worksheets(1).UsedRange
If rng.DisplayFormat.Interior.Color = vbRed Then
MsgBox ("Please correct any fields highlighted in red")
Cancel = True
Application.ScreenUpdating = True
Exit Sub
End If
Next rng
Application.ScreenUpdating = True
If Cancel Then MsgBox "Please accept the terms and conditions before saving the Invoice"
End Sub
I am trying to declare a range of cells as an Excel.Range variable in the BeforeSave() event of my excel workbook.
The background is, that the values in this range are mandatory inputs and I want to validate that they are all filled on saving.
If I want to execute the function I get the error message
Runtime Error "13": Type Mismatch
Here's the code I tried.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r1 As Range
Set r1 = Range("G11:G14")
If Cells(10, 1).Value = "" Then
MsgBox "Cell requires user input", vbInformation, "Please filled up the mandatory cells"
Cancel = True
Exit Sub
ElseIf r1.Value = "" Then // runtime error "13": Type Mismatch
MsgBox "Please make sure you had filled in all the Questionnire Answers.", vbInformation, "Missing Answer"
Cancel = True
Exit Sub
End If
Cancel = False
End Sub
I am relatively new to VBA so please feel free to point out my mistake.
Thanks in advance!
You will get this error:
Runtime Error "13": Type Mismatch
Because r1 is defined as a Range of multiple cells and you cannot check if a multiple-cell Range is simply empty string. You need to check each cell in the range.
Try this code - it is a Function that checks to see if any cell, in a group of cells, is "" and returns True if that is so:
Option Explicit
Function TestMultipleCellsAnyAreEmpty(rng As Range) As Boolean
Dim rngCell As Range
Dim blnAnyRangeIsEmpty
blnAnyRangeIsEmpty = False
For Each rngCell In rng
If rngCell.Value = "" Then
blnRangeIsEmpty = True
Exit For
End If
Next rngCell
TestMultipleCellsAreEmpty = blnRangeIsEmpty
End Function
Combining this technique with your workbook event you can have this complete code:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r1 As Range
Set r1 = ThisWorkbook.Worksheets("YOUR_SHEET").Range("G11:G14") '<-- specify the worksheet
If ThisWorkbook.Worksheets("YOUR_SHEET").Cells(10, 1).Value = "" Then '<-- specify the worksheet
MsgBox "Cell requires user input", vbInformation, "Please filled up the mandatory cells"
Cancel = True
Exit Sub
ElseIf TestMultipleCellsAnyAreEmpty(r1) Then
MsgBox "Please make sure you had filled in all the Questionnire Answers.", vbInformation, "Missing Answer"
Cancel = True
Exit Sub
End If
Cancel = False
End Sub
Function TestMultipleCellsAnyAreEmpty(rng As Range) As Boolean
Dim rngCell As Range
Dim blnAnyRangeIsEmpty
blnAnyRangeIsEmpty = False
For Each rngCell In rng
If rngCell.Value = "" Then
blnRangeIsEmpty = True
Exit For
End If
Next rngCell
TestMultipleCellsAreEmpty = blnRangeIsEmpty
End Function
I suspect it's because you need to qualify your range definition to say Set r1 = ThisWorkbook.Range("G11:G14"). Also, I believe that the .Value property of a multi-cell range will return the value in the top leftmost cell.
Big thanks to A.S.H for helping me with out with this code earlier.
Right now, I'm attempting to show a splash sheet that tells users to enable macros in order to access the workbook. The plan is to save the file with the splash sheet visible and other sheets veryhidden during the BeforeClose event. During the Open event, the splash sheet will be made veryhidden and the other sheets will be made visible.
Hence, the user will only see the splash sheet when he/she opens the file with macros disabled. However with the below code, it doesn't seem as though the routine that makes the splash sheet visible and the rest veryhidden is running. Where have I gone wrong?
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
Do
Ans = MsgBox("Do you want to save the changes you made to '" & _
Me.Name & "'?", vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
With rs
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.Value = Application.Trim(target.Value)
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
Cancel = True
r.Parent.Activate: r.Activate
MsgBox ("Please confirm all required fields have been completed")
Exit Sub
End If
Next
Application.ScreenUpdating = False
Sheets("Reminder").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVeryHidden
End If
Next ws
ActiveWorkbook.Save
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reminder" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("Reminder").Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
Application.ScreenUpdating = True
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
Loop Until ThisWorkbook.Saved = True
End If
End Sub
If you are experiencing screen trouble, it is likely due to some erroneous manipulation of Application.ScreenUpdating here and in other macros. In this one, the error is that you first set it to False and then Exit Sub without restoring it to True.
Moreover, since your routine only does calculation (checking) and does not change cell values, there's no point in disabling Application.ScreenUpdating.
On a side note, I think your routine that checks for empty cells can be much simplified.
Function dataIsValid() As Boolean
Dim target As Range, r As Range
With ActiveSheet ' <-- May be better change to some explicit sheet name
Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With
target.value = Application.Trim(target.value) ' <-- trim the whole range
For Each r In target.Rows
If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
r.Parent.Activate: r.Activate ' <-- Show erroneous row
MsgBox ("Please confirm all required fields have been completed")
Exit Function
End If
Next
dataIsValid = True
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Not dataIsValid
End Sub
I have an Excel spreadsheet that contains 7 worksheets.
I need the script below to be applied to only some of the worksheets (Sheet6 & Sheet7) whenever the document is saved.
I've spent several hours trying different modifications, must of which simply did not work. The VBA debugger does not throw any errors, and when I test the script it never appears to run.
How can the script below be modified to run against specific worksheets, whenever I save the document from any of the worksheet tabs?
Thank you
VBA - Lock Cells & Protect Sheet On Save
The script below will lock cells that contain values, and then password protect the sheet before saving.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Dim Cell As Range
With ActiveSheet
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In Application.ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
Exit Sub
End Sub
Script Source
Change the ActiveSheet and use a For Each loop like so:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Dim Cell As Range
For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")
With Sheets(sh)
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In Application.ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next
.Protect Password:=""
End With
Next
End Sub
This should help you (you'll have messages to let you know when you are in the event and when it's started and over) :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Cell As Range
MsgBox "Event Workbook_BeforeSave Launched", vbInformation + vbOKOnly, "Started"
On Error GoTo ErrHandler
ReTry:
With Sheet6
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In .UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
With Sheet7
.Unprotect Password:=""
.Cells.Locked = False
For Each Cell In .UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=""
'Protect with blank password, you can change it
End With
MsgBox "Event Workbook_BeforeSave Over", vbInformation + vbOKOnly, "Finished"
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & " :" & vbCrLf & _
Err.Description
Resume ReTry
End Sub
The code can be significantly shorted (run time wise) by
Using SpecialCells rather than looping through each cell
avoiding setting blank cells as being locked twice (minor compared to first point).
updated
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet")
With Sheets(sh)
.Unprotect
.Cells.Locked = True
On Error Resume Next
.Cells.SpecialCells(xlBlanks).Locked = False
On Error GoTo 0
.Protect
End With
Next
End Sub
I am creating a spreadsheet where people are to enter when something has been completed. I figured the most efficient way would be to use double click tick boxes. However, I want to pull the user ID and the timestamp for this, and don't want anyone to be able to edit anything except if they are double clicking something for the first time.
I have the below which works for what I need but I don't know how to protect the sheet exactly as I wish.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Offset(0, 1).Value = Environ("UserName")
Target.Offset(0, 2).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Cancel = True
Exit Sub
End If
End Sub
Also, if I protect columns C and D then it won't let the macro enter the values needed there. I know I may need to protect the whole worksheet and have it unlock the cells upon a double click to allow the change to happen and then lock again straight after but I can't figure out how to manage that!
Any help is appreciated!
What you could do is protect the sheet as usual and put in the check-boxes. Then assign this macro to all the checkboxes -
Sub ChkBxClk()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.ControlFormat.Value = xlOff Then
MsgBox ("This was already checked off")
shp.ControlFormat.Value = xlOn
Exit Sub
End If
If shp.ControlFormat.Value = xlOn Then
ActiveSheet.Unprotect
Dim rng As Range
Set rng = Range(shp.TopLeftCell.Address)
rng.Offset(0, 1).value = Environ("UserName")
rng.Offset(0, 2).value = Format(Now, "yyyy-mm-dd hh:mm:ss")
ActiveSheet.Protect
End If
End Sub
Now, if a user checks a box (which is allowed on a protected sheet), it will unlock and allow you to enter what you want in the offset cells.