Issue with Deleting a row in a table

spydey

Active Member
Joined
Sep 19, 2017
Messages
314
Office Version
  1. 2013
Platform
  1. Windows
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:

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
 
Last edited:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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

Code:
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
 
Last edited:
Upvote 0
Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top