Issue with Deleting a row in a table

[spydey]

I have some code that will check to see if a change has happened in worksheet Quotes, Column "C". If it has, and Column "B" is blank, it will then place a datetime in Column "B" and then an ID from worksheet Misc.

Worksheet Quotes is made up of a table.
Worksheet Misc, range QuoteIDList is a table too; it currently has the header and then a single cell with a number in it.

When I try to delete a row in my Quotes Table, it populates column A & B and advances the Quote ID in worksheet Misc.

I imagine because a change has happened in column "C", i.e. me deleting a row, so it updates columns A & B, even though a value wasn't input into column C.

FYI, sheet Quotes row 1 contains the headers of my table in that worksheet.

Anyway I can stop this from happening?

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range
    Dim maxNumber
    Dim wb As Workbook
    Dim ws As Worksheet


    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Misc")


    On Error GoTo ErrorHandler
    Application.EnableEvents = False


    If Not Intersect(Range("C:C"), Target) Is Nothing Then
        For Each cell In Intersect(Range("C:C"), Target)
            Select Case cell.Column
                Case 3
                    If IsEmpty(cell.Offset(0, -1)) Then
                        cell.Offset(0, -1).Value = Now
                        maxNumber = Application.WorksheetFunction.Max(ws.Range("QuoteIDList"))
                        maxNumber = maxNumber + 1
                        cell.Offset(0, -2).Value = maxNumber
                        ws.Range("QuoteIDList").End(xlUp).Offset(1, 0).Value = maxNumber
                    ElseIf IsEmpty(cell.Value) Then
                        cell.Offset(0, -1).ClearContents
                        cell.Offset(0, -2).ClearContents
                    End If
            End Select
        Next cell
    End If


ErrorHandler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, "Error " & Err.Number


End Sub

Any help is very much appreciated.

-Spydey

 

[Yongle]

Monitor a Named Range
One method to deal with this is to name a cell MUCH further down the worksheet and monitor what happens to that
(must be below range anticipated to be used for any data input)
If its RefersTo Range has changed then a row has been added or deleted

The VBA below monitors whether the ROW of named range "TestCell" changes
If it does, then VBA exits Worksheet_Change
"TestCell"'s RefersTo is reinstated EVERY time Worksheet_Change is triggered

Suggest you test in a new workbook
- Create Named Range "TestCell" with refers to range ...
=Sheet1!$A$100000

- Insert the VBA below in the sheet module

Test by amend cell values and deleting rows
- when any cell is amended the message box pops up
- which does not happen when a row (1 to 99,999) is inserted or deleted

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not IsCellStatic Then Exit Sub
   
    MsgBox "original code goes here after testing"
End Sub

Private Function IsCellStatic() As Boolean
    Const ConstRefersTo = "=Sheet1!$A$100000"
    With ThisWorkbook.Names("TestCell")
        If .RefersToRange.Row = Split(ConstRefersTo, "$")(2) Then IsCellStatic = True
        .RefersTo = ConstRefersTo
    End With
End Function

 

[spydey]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not IsCellStatic Then Exit Sub
   
    MsgBox "original code goes here after testing"
End Sub

Private Function IsCellStatic() As Boolean
    Const ConstRefersTo = "=Sheet1!$A$100000"
    With ThisWorkbook.Names("TestCell")
        If .RefersToRange.Row = Split(ConstRefersTo, "$")(2) Then IsCellStatic = True
        .RefersTo = ConstRefersTo
    End With
End Function

Just gave it a try. Had to adjust a few things but it works great!

I really appreciate your assistance.

-Spydey

 

[Yongle]

thanks for the feedback