Worksheet_Change private sub Run-time Error when deleting cell values

[mws4ua]

The code below is acting as expected...

• If user enters "Personal" in any cell in Column J, cells on the same row in Columns K & L auto-fill with "Personal"
• If user enters either "Misc." or "Other Meals" in Column K, cells on the same row in column L auto-fill with the same word

HOWEVER, any time multiple cells in (or among) columns J, K, and L are selected and the values cleared (Delete key) I get the error: "Run-time error '13': Type mismatch" and clicking Debug highlights the red code below.

Any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
    
  
    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        [COLOR=#ff0000]If Target.Value = "Personal" Then[/COLOR]
                Target.Offset(0, 1).Value = Target.Offset(0, 0).Value 
                Target.Offset(0, 2).Value = Target.Offset(0, 0).Value 
        End If
    End If
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Other Meals" Then
                Target.Offset(0, 1).Value = Target.Offset(0, 0).Value
        End If
    End If


    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Misc." Then
                Target.Offset(0, 1).Value = Target.Offset(0, 0).Value
        End If
        Else
            Set Target = Nothing
    End If
    
End Sub

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Modified  5/29/2019  11:27:57 PM  EDT
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        If Target.Value = "Personal" Then
                Target.Offset(0, 1).Value = Target.Value
                Target.Offset(0, 2).Value = Target.Value
        End If
    End If
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Other Meals" Then Target.Offset(0, 1).Value = Target.Value
        If Target.Value = "Misc." Then Target.Offset(0, 1).Value = Target.Value
    End If
    End Sub

 

[My Aswer Is This]

Try this using OR

See Or marked in red:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Modified  5/29/2019  11:34:17 PM  EDT
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        If Target.Value = "Personal" Then
                Target.Offset(0, 1).Value = Target.Value
                Target.Offset(0, 2).Value = Target.Value
        End If
    End If
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Other Meals" [COLOR=#ff0000]Or[/COLOR] Target.Value = "Misc." Then Target.Offset(0, 1).Value = Target.Value
    End If
    End Sub

 

[My Aswer Is This]

Or this:

You will see I used Resize
Marked in Red.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Modified  5/29/2019  11:41:25 PM  EDT
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        If Target.Value = "Personal" Then Target.Offset(0, 1).[COLOR=#ff0000]Resize[/COLOR](, 2).Value = Target.Value
    End If
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Other Meals" Or Target.Value = "Misc." Then Target.Offset(0, 1).Value = Target.Value
    End If
    End Sub

 

[mws4ua]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Modified  5/29/2019  11:27:57 PM  EDT
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        If Target.Value = "Personal" Then
                Target.Offset(0, 1).Value = Target.Value
                Target.Offset(0, 2).Value = Target.Value
        End If
    End If
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If Target.Value = "Other Meals" Then Target.Offset(0, 1).Value = Target.Value
        If Target.Value = "Misc." Then Target.Offset(0, 1).Value = Target.Value
    End If
    End Sub

I don't know how/why that bit of code works, but it certainly does. Thank you!

Try this using OR

See Or marked in red:

Or this:

You will see I used Resize
Marked in Red.

Thank you, too, for these efficiencies. My code now looks like your most recent post and it's working error free.

Thanks again.

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

I don't know how/why that bit of code works, but it certainly does. Thank you!





Thank you, too, for these efficiencies. My code now looks like your most recent post and it's working error free.

Thanks again.