Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Creating a warning in Excel when multiple pages are selected to prevent accidental overwriting of cells

Tags:

excel

vba

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).

like image 226
Michael Avatar asked Dec 14 '15 16:12

Michael


People also ask

How do you make a cell Uneditable in Excel?

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.

How do I lock cells in Excel VBA?

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.


2 Answers

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
like image 159
EEM Avatar answered Sep 29 '22 14:09

EEM


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
like image 40
Scott Holtzman Avatar answered Sep 29 '22 15:09

Scott Holtzman