VBA Code to Clear Contents of Cell based on Another Cell

[leonalap24]

Hi, I need help writing a code that will clear the contents of cells D10:G10 & I10:M10 if the contents of cell C10 are deleted. I need for the corresponding rows down do D33:G33 & I33:M33 & C33.

I am able to make it work for the first row but not sure how to include the additional rows without referencing each row individually.

Please help.

Thanks in advance.

 

[mumps]

I entered some dummy data in columns D to G and I to M then deleted the data in column C and the appropriate range cleared properly. I didn't get a "runtime error 13 type mismatch" message. Also your macros are protected with a password so I couldn't see what you already had there.

 

[mumps]

It looks like you may have been selecting more than one cell at a time in column C. This would generate the error. Try this code. It will allow you to make multiple selections.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C10:C33")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim myRange As Range
    Dim myCell As Range
    Set myRange = Target
    Application.EnableEvents = False
    On Error GoTo errhandler
    For Each myCell In myRange.Cells
        If myCell = "" Then
            Range("D" & myCell.Row & ":G" & myCell.Row).ClearContents
            Range("I" & myCell.Row & ":M" & myCell.Row).ClearContents
        End If
    Next myCell
    Application.EnableEvents = True
    Application.ScreenUpdating = True
errhandler:
    Application.EnableEvents = True
End Sub

 

[leonalap24]

Try adding the blue line.

Private Sub Worksheet_Change(ByVal Target As Range)
  [COLOR=#0000ff]If target.Count > 1 Then Exit Sub[/COLOR]
...
...
...

Thanks so much! That fixed the problem but now I have another one. I just realized if I select more than one row and clear contents if doesn't clear the corresponding cells. It works great if I only clear contents on one cell. Any ideas?

 

[Peter_SSs]

Try this Worksheet_Change code. You would need to remove the other(s).

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("C10:C33")) Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next
    Intersect(Range("C10:C33").SpecialCells(xlBlanks).EntireRow, Range("D:G,I:M")).ClearContents
    On Error GoTo 0
    Application.EnableEvents = True
  End If
End Sub