Pick up on a second Change event

[AndyGalloway]

This is a very small query and I have identified a few solutions myself, but I'm sure there must be something even easier, I just can't figure how to make that happen.

In a sheet, when a cell in Column A is selected (personnel name) I load the cell contents into a variable. If the "Delete" key is pressed on the keyboard, I use the change event to display a MessageBox asking if they are sure. If "Yes" follow a whole delete routine. If "No" write the variable back into the cell and display a message "Name reinstated". If I move elsewhere on the sheet and come back to this cell, this code is fine. However, if I remain in the same cell i.e. don't select that cell again, and then press the "Delete" key on my keyboard for a second time, then the Change event is not fired and so the delete routine doesn't get followed.

Question: Is there a way to trigger the Change event a second time on the same cell? My original thought is to just focus on another cell and then back to this one again. That doesn't seem very elegant. Do you have a better solution?

 

[Yongle]

You are using Worksheet_Selection_Change which ONLY fires when a different cell is selected

Use Worksheet_Change to do the required things when the value in ColumnA is deleted

If you want help, post BOTH your current Worksheet_Selection_Change and Worksheet_Change procedures in full

thanks

 

[Legacy 456155]

If you want help, post BOTH your current Worksheet_Selection_Change and Worksheet_Change procedures in full

Yah!

My original thought is to just focus on another cell and then back to this one again. That doesn't seem very elegant.

I still took a crack at your issue though elegance is not really one of my priorities.

Option Explicit

Dim rememberMe As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([A:A], Target) Is Nothing Then
        If Target.CountLarge = 1 Then
            rememberMe = Target
            Application.OnKey "{DEL}", Me.CodeName & ".DeleteButtonPressed"
        End If
    Else
        Application.OnKey "{DEL}"
    End If
End Sub

Public Sub DeleteButtonPressed()
    If MsgBox("Delete?", vbYesNo + vbDefaultButton2) = vbNo Then
        ActiveCell = rememberMe
    Else
        ActiveCell = Empty 'or vbNullString or something
    End If
End Sub

 

[mumps]

I tried this Worksheet_Change event on some dummy data and it seemed to work properly. I inserted a data validation drop down list of personnel names in column A and selected any name.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim val As String
    If Target <> "" Then
        val = Target
    Else
        If MsgBox("Are you sure?", vbYesNo) = vbYes Then
            MsgBox "Run delete routine"
        Else
            Application.Undo
            MsgBox "Name reinstated"
        End If
    End If
End Sub

 

[Yongle]

Or ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Or Target <> "" Then Exit Sub
    If MsgBox("Are you sure?", vbYesNo) <> vbYes Then Application.Undo
End Sub

 

[NoSparks]

My original view on this was that events should be disabled but I do like Yongle's suggestion with this part removed

  Or Target <> ""

so it will flip-flop the undo back and forth until Yes is chosen.

 

[AndyGalloway]

This is the code I'm using at the moment at the point I determine that the user wants to abort the delete routine. I use the .EnableEvents to stop the code triggering the Change event again until after the .Undo has reinstated the name.

    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With

 

[Yongle]

If post#7 is the full procedure (as requested in post#2) then
- delete Worksheet_Selection_Change completely
- add Worksheet_Change as provided in post#5

Also test the other solutions to see which one suits your needs the best

 

[AndyGalloway]

Sorry for the delay in getting back to you. I've succeeded in doing what I set out to do, with your help. This is what I went with in the end. Using the Workbook_SheetSelectionChange event to set some variables and set the Delete key every time there is a change of selection, if on "Employees Register", in column 1 below row 3. Otherwise, don't set the variables and reset the Delete key. The "Delete_Staff" sub has been moved from Sheet1 to Module1. If the Delete key is pressed whilst a suitable active cell is selected, the user is asked to verify the deletion, if not, close the messagebox. If so, delete myRow on the first worksheet, the same row on the next worksheet and particular column on the third sheet. After deleting from the second sheet, the first row is re-written with a formula to show the corresponding staff in the correct rows. Similarly, the column headings in the third sheet are re-written to show the correct staff in that sheet.

Public myRow As Integer
Public varTargetCell As Variant
Public varStaffCount As Long
Public varOldStaffCount As Long

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim CurrSh As String
    CurrSh = ActiveSheet.Name
       
    If CurrSh = "Employees Register" Then
        If ActiveCell.Column = 1 Then
            If ActiveCell.Row > 3 Then
                varStaffCount = WorksheetFunction.CountA(Worksheets("Employees Register").Range("A3", Worksheets("Employees Register").Range("A3").End(xlDown)))
                varTargetCell = Target.Address
                myRow = Target.Row
                varOldStaffCount = varOldStaffCount - 1
                varTargetCell = Target.Address
                myRow = Target.Row
                Application.OnKey "{DEL}", "Delete_Staff"
            End If
        Else
            Application.OnKey "{DEL}"
        End If
    Else
        Application.OnKey "{DEL}"
    End If
   
End Sub

Public Sub Delete_Staff()

    ' This routine is accessed by placing the cursor in column A of the Employees Register
    ' In this case, the {DEL} key is re-written to put this code onto the Delete key
    ' The Delete Key is reverted back to normal by placing the cursor on any other column in the woorkbook
    ' See the Workbook_SheetSelectionChange routine

    ' Set up the password for protection of sheets
    strPass = "12345qwertasdfgzxcvb"
    r = vbNo
    Dim s As Integer

    Application.ScreenUpdating = False
   
    r = MsgBox("Delete this member of staff?", vbYesNo, "Delete staff?")
    If r = vbYes Then
        ' Now delete the rows and columns in all the relevant worksheets
       
        ' Starting with the Employees Register
        Set ws = ThisWorkbook.Sheets("Employees Register")

        ' First unprotect the sheet
        ws.Unprotect (strPass)
        ws.Rows(myRow).Delete

        ' Lock the worksheet
        ws.Protect Password:=strPass
       
        ' Then the Internal Training Matrix
        Set ws = ThisWorkbook.Sheets("Internal Training Matrix")

        ' First unprotect the sheet
        ws.Unprotect (strPass)
        ws.Rows(myRow).Delete
       
        ' Rewrite the formulae in the Staff rows
        For s = 1 To varOldStaffCount - 1
            myString1 = "=IF('Employees Register'!A" & s + 2 & "<>"""",'Employees Register'!A" & s + 2 & ","""")"
            myString2 = "=IF('Employees Register'!B" & s + 2 & "<>"""",'Employees Register'!B" & s + 2 & ","""")"
            ws.Cells.Item(s + 2, 1) = myString1
            ws.Cells.Item(s + 2, 2) = myString2
        Next
       
        ' Lock the worksheet
        ws.Protect Password:=strPass
       
        ' Then the External Training Matrix
        Set ws = ThisWorkbook.Sheets("External Training Matrix")
        myCol = myRow - 2 + 5
        ' First unprotect the sheet
        ws.Unprotect (strPass)
        ws.Columns(myCol).Delete

        ' Rewrite the formulae in the Staff columns
        For s = 1 To varOldStaffCount - 1
            myString1 = "=IF('Employees Register'!A" & s + 2 & "<>"""",'Employees Register'!A" & s + 2 & ","""")"
            ws.Cells.Item(5, s + 5) = myString1
        Next
       
        ' Lock the worksheet
        ws.Protect Password:=strPass

    End If
   
    Application.ScreenUpdating = True

End Sub

 

[Yongle]

Looks good
- simple code
- with clear commentary

thanks for the feeeback