Tables/ListObjects - Worksheet_Change Event runs twice

user_5711178 0
Viewed 34

I'm working with the Worksheet_Change Event of a Worksheet. In this Worksheet I have a certain range that I don't want the user to edit. The range also includes a table (ListObject) header, which is on row 4. Which I also don't want changed.

When the user presses Delete key on a cell in this header, Worksheet_Change Event runs twice: one time when the column header changes to "ColumnX" (1,2,3...) -and- one time when Excel would normally change the cell.

To prevent this from happening twice, I wrote the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    Dim sh As Worksheet: Set sh = Target.Worksheet
    Dim r As Long: r = Target.Row
    Dim c As Long: c = Target.Column
    Dim ArrHeaderNames As Variant, arrCols As Variant, i As Long, j As Long, n As Long
    Dim cellTopLeft As Range, cellBottomRight As Range

    r = 1: c = 1: Set cellTopLeft = Sheet007.Cells(r, c)                'A1
    r = r + 3: c = c + 44: Set cellBottomRight = Sheet007.Cells(r, c)   'AS4
    Set rng = Sheet007.Range(cellTopLeft, cellBottomRight)

    If Intersect(Target, rng) Is Nothing Then
        ...allow code to run in here...
    Else
        If Target.Value2 Like "Column*" Then 'this is for the Table/ListObject header change
            Application.EnableEvents = False: Application.Undo: Application.EnableEvents = True
        ElseIf Target.Row <> 4 Then 'this is for Excel normal cells in my "don't edit" range
            Application.EnableEvents = False: Application.Undo: Application.EnableEvents = True
        End If
    End If

Is there any simpler solution than using an "If..ElseIf..End If" in the "undo" part (Else) at the bottom?

Thank you in advance.

vba excel
1 Answers

I would name the range that the user must not change, e.g. lockedData or may be sth. that explains why this area shouldn't be changed by user, e.g. AdminVariables.

Furthermore you can use the HeaderRowRange object of listobject to access the tables header range.

For readability reasons I put the Intersect-results into variables - and then check the variables. Obviously you could put the 'Intersect-checks in the If`-clause as well.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim changeInTableHeader As Boolean
changeInTableHeader = Not Intersect(Target, Me.ListObjects("tblData").HeaderRowRange) Is Nothing     'change name to your needs

Dim changeinLockedData As Boolean
changeinLockedData = Not Intersect(Target, Me.Range("lockedData")) Is Nothing


If changeInTableHeader Or changeinLockedData Then
    MsgBox "You are not allowed to make changes here!", vbExclamation, "Locked area"
    Application.EnableEvents = False: Application.Undo: Application.EnableEvents = True
Else
    'run your code
End If

End Sub

I added a MsgBox - I think user should be informed that you are resetting his/her action.

user_165784240
Related