Worksheet_change: removed integer column value, identify non-empty cells before this action

Question

I have a book with a main sheet for input, and the values ​​from the main sheet are copied into 2 subclasses based on the cell value of the "type" column in the main sheet.

Any value in the "comments" column in subpackages against these copied cells is added as comments to the corresponding row of the corresponding sheet. When the values ​​in the “comments” column in subpackages are deleted immediately, I want to identify non-empty cells before this action and delete the corresponding comments in the main sheet.

Currently, I have written code if the value is added / deleted in the "comments" column in an additional sheet, which will then add / remove comments in the corresponding element of the main sheet.

Private Sub Worksheet_Change(ByVal Target As Range) Dim temp As String Dim tem As String With Target If .Count = 1 And .Column = 8 And .Row < 600 Then tem = .Row If Sheets("Parts- input").Cells(tem, 8).Comment Is Nothing Then If Sheets("Pins").Cells(.Row, .Column).Value = "" Then Sheets("Parts- input").Cells(tem, 8).Comment.Delete Else Sheets("Parts- input").Cells(tem, 8).AddComment "Lifts Sheet: " & Sheets("Pins").Cells(.Row, .Column).Value End If Else If Sheets("Pins").Cells(.Row, .Column).Value = "" Then Sheets("Parts- input").Cells(tem, 8).Comment.Delete Else Sheets("Parts- input").Cells(tem, 8).Comment.Text "Lifts Sheet: " & Sheets("Pins").Cells(.Row, .Column).Value End If End If End If End With End Sub 

Answer 1

just playing with your code, I get the following:

 Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count = 1 And .Column = 8 And .row < 600 Then If Sheets("Pins").Cells(.row, .Column).Value = "" Then Sheets("Parts- input").Cells(.row, 8).Comment.Delete Else If Sheets("Parts- input").Cells(.row, 8).Comment Is Nothing Then Sheets("Parts- input").Cells(.row, 8).AddComment "Lifts Sheet: " & Sheets("Pins").Cells(.row, .Column).Value Else Sheets("Parts- input").Cells(.row, 8).Comment.Text "Lifts Sheet: " & Sheets("Pins").Cells(.row, .Column).Value End If End If Else If Not Intersect(Target, Target.Parent.Range("H1:H599")) Is Nothing Then Dim runner As Range, rng As Range For Each runner In Intersect(Target, Target.Parent.Range("H1:H599")).Cells If Sheets("Pins").Cells(runner.row, 8).Value = "" Then If rng Is Nothing Then Set rng = Sheets("Parts- input").Cells(runner.Rows, 8) Else Set rng = Union(rng, Sheets("Parts- input").Cells(runner.Rows, 8)) End If End If End If Next rng.Comment.Delete End If End With End Sub 

you can delete them directly, but having many cells, doing it in one step will be faster :)

EDIT enabled by Intersect to improve speed