Detect on worksheet change if user is deleting

Question

I'd like to know how to detect if the user is deleting or inserting content into a range. If they are deleting a range say D14:D18. I'd like to then perform a macro that also deletes content in E14:E18. I just wouldn't want to delete E14:E18 if they are entering content into D14:D18.

I've tried:

If Selection.ClearContents Then
    MsgBox Target.Offset(0, 3).Style
End If

But this get's me stuck in an infinite loop.

A bit more context:

I have a few hundred cells in D:D for entering quantities for services. Not everything in D:D should be touched. Only cells in D:D with .Style = "UnitInput". In E:E I have data validation that lets the user only enter contractor 1 or contractor 2 But, when content is entered in D:D I run a macro to assign the default contractor (housed in F:F) to E:E. So when the user enters quantities into D:D it correctly assigns the default contractor. And when they delete singular items from D:D I have it handling proper removal of contractors. It's only when they delete a range of items from D:D.

Full code:

 Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    On Error GoTo ErrHandler:
    If Selection.Rows.Count * Selection.Columns.Count = 1 Then
        If Target.Offset(0, 3).Style = "Contractor" Then
            If Target.Value < 1 Then
                Target.Offset(0, 3).Value = ""
            Else
                Target.Offset(0, 3).Value = Target.Offset(0, 2).Value
            End If
        End If

        If Target.Offset(0, 5).Style = "Markup" Then
            If Target.Value = "" Then
                Target.Offset(0, 5).Value = ""
            ElseIf Target.Value <= Target.Offset(0, 14).Value Then
                Target.Offset(0, 5).Value = "Redact 1"
            ElseIf Target.Value >= Target.Offset(0, 15).Value Then
                Target.Offset(0, 5).Value = "Redact 2"
            Else
                Target.Offset(0, 5).Value = "Redact 3"
            End If
        End If
    Else
        '!!!!!! this is where I need to handle multiple deletions. !!!!!!!
    End If

    Application.ScreenUpdating = True
ErrHandler:
    Application.ScreenUpdating = True
    Resume Next
End Sub

Answer 1

Based on your comments in chat, here is what I propose

UNTESTED

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, aCell As Range
    Dim lRow As Long

    '~~> Error handling, Switching off events and Intersect
    '~~> As described in
    '~~> http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs
    On Error GoTo Whoa

    Application.EnableEvents = False

    With ActiveSheet
        '~~> Find Last Row since data is dynamic
        '~~> For further reading see
        ' http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        End If

        If lRow > 12 Then
            '~~> Set your range
            Set rng = Range("D13:D" & lRow)

            If Not Intersect(Target, rng) Is Nothing Then
                For Each aCell In rng
                    If Len(Trim(aCell.Value)) = 0 Then
                        Select Case Target.Offset(0, 3).Style
                        Case "Contractor"
                            '~~> Do Your Stuff
                        Case "Markup"
                            '~~> Do Your Stuff
                            '
                            '~~> And so on
                            '
                        End Select
                    End If
                Next aCell
            End If
        End If
    End With

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub