Worksheet_change: valore di intera colonna cancellato, identificare celle non vuote prima di questa azione

Question

Ho una cartella di lavoro con un foglio principale per l'input e i valori del foglio principale vengono copiati su 2 sottos fogli in base al valore della cella della colonna "tipo" nel foglio principale.

Qualsiasi valore nella colonna "commenti" nei sottos fogli rispetto a queste celle copiate viene aggiunto come commento alla riga corrispondente del foglio principale. Quando i valori nella colonna "commenti" nel foglio secondario vengono eliminati contemporaneamente, desidera identificare le celle non vuote prima di questa azione ed eliminare i commenti corrispondenti nel foglio principale.

Attualmente ho scritto il codice se un valore è aggiunto/eliminato nella colonna "commenti" nel foglio secondario che quindi aggiungere/eliminare commenti nella voce corrispondente della scheda principale.

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

solo giocando con il codice, i endet con questo:

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 

si potrebbe eliminarli direttamente, ma avendo un sacco di cellule, farlo in un solo passo sarà più veloce :)

EDIT incluso Intersect per migliorare la velocità