I am attempting to write a bit of Visual Basic code to prevent anyone from accidentally overwriting cells across multiple sheets when multiple sheets are selected.
I do however want the option of overwriting cells across multiple sheets, should that be required at any stage.
So, when I have multiple sheets selected I would like a pop up with 2 options, as follows: "Are you sure you want to overwrite the cells across the sheets you have selected?" Ok Cancel
I think I am nearly there with the code below, but if I have 3 sheets selected then the pop up will appear 3 times (once for each page). Naturally I only want the pop up to appear once regardless of how many sheets I have selected.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveWindow.SelectedSheets.Count > 1 Then
If MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected?", vbOKCancel) = vbCancel Then Exit Sub
Application.EnableEvents = False
Application.Undo
End If
Application.EnableEvents = True
End Sub
Or an even better solution would actually be:
"Are you sure you want to overwrite the cells across the sheets you have selected?"
Yes (to continue with all selected pages),
No (to select current page and continue),
Cancel (to cancel operation and keep current selection).
Press the Ctrl + 1 keys simultaneously to open the Format Cells dialog box, check the Locked box under the Protection tab and click the OK button.
Select a cell or a range of cells, and press Ctrl + 1 to open this menu and go to the Protection tab. Use the corresponding checkboxes to activate properties. The second method is doing this via VBA code. Every cell and range can be made Locked and FormulaHidden properties.
This solution validates if the event worksheet is the active worksheet in order to fire the Multiple Selection procedure.
Also if user chooses to update only the active sheet, the procedure leaves all other sheets included in the selection as they were before the action that triggered the vent, instead of the undesired effect of entering in all those cell the vbNullString
value
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Sh.Name = ActiveSheet.Name Then Call Wsh_MultipleSelection(Target)
Application.EnableEvents = True
End Sub
Private Sub Wsh_MultipleSelection(ByVal rTrg As Range)
Const kTtl As String = "Selection Across Multiple Sheets"
Const kMsg As String = "You are trying to overwrite cells across multiple sheets." & vbLf & _
"Press [Yes] if you want to continue and overwrite the selected cells" & vbLf & _
"Press [No] if you want to overwrite selected cells in active sheet only" & vbLf & _
"Press [Cancel] to undo last action."
Const kBtt As Long = vbApplicationModal + vbQuestion + vbYesNoCancel + vbDefaultButton3
Dim iResp As Integer
Dim vCllVal As Variant
Dim bWshCnt As Byte
bWshCnt = ActiveWindow.SelectedSheets.Count
If bWshCnt > 1 Then
bWshCnt = -1 + bWshCnt
iResp = MsgBox(kMsg, kBtt, kTtl)
Select Case iResp
Case vbYes
Rem NO ACTION!
Case vbNo:
Rem Select Only Active Sheet
vCllVal = rTrg.Cells(1).Value2
Application.Undo
rTrg.Value = vCllVal
Case Else
Rem Cancel
Application.Undo
End Select: End If
End Sub
This is very tricky, since by using the Workbook_SheetChange
event the code will fire for every instance of a sheet change which you have to account for.
However, with some crafty use of public variables to use as a switch / counter and a separate sub-routine to process which cases to change all vs. active vs. no worksheets, I have developed code that has been thoroughly tested. I have also heavily commented my code to help understand the logic.
Option Explicit
Dim bAsked As Boolean
Dim dRet As Double
Dim iCnt As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim lSheets As Long
lSheets = ActiveWindow.SelectedSheets.Count
If lSheets > 1 Then Check lSheets, Sh, Target
Application.EnableEvents = True
End Sub
Sub Check(iTotal As Long, ws As Worksheet, rng As Range)
'use this is a counter to count how many times the sub has been called in the firing of the 'Workbook_SheetChange` event
iCnt = iCnt + 1
'if the question has not been asked yet (first time event is fired)
If Not bAsked Then
dRet = MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected? Click Yes to overwrite all sheets, No to overwrite the Active Sheet, or Cancel to abort the entire overwrite.", vbYesNoCancel)
bAsked = True 'set to true so question will only be asked once on event firing
End If
'dRet will always be the same for each instance an event is fired
Select Case dRet
Case Is = vbYes
'set the value for each range to what user entered
ws.Range(rng.Address) = rng.Value2
Case Is = vbNo
'only set the value the user entered to the active worksheet (the one the user is on)
If ActiveSheet.Name = ws.Name Then
ws.Range(rng.Address) = rng.Value2
Else
ws.Range(rng.Address) = vbNullString
End If
Case Is = vbCancel
'do not set any values on any sheet
Application.Undo
End Select
'if the total times the sub has been called is equal to the total selected worksheet reset variables so they work next time
'if the count equals the total it's the last time the sub was called which means its the last sheet
If iCnt = iTotal Then
bAsked = False
iCnt = 0
End If
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With