Delete cells in current row when deleting cell contents in column

[CMcColm]

I've been trying to do this for a couple of days and I've made some headway but I'm struggling with it. I have made the macro I want but it's the activation I am struggling with.

Range("B" & ActiveCell.Row & ":I" & ActiveCell.Row).ClearContents

That is what I want to activate but I only want to activate it if someone deletes the contents of "J".

It's basically for tracking. "J" must have initials in it before other cells in the row can be modified. I want the whole row to clear if someone puts in their initials, fills in the rest of the row, then deletes their initials.

Thanks!

 

[JLGWhiz]

Copy this code and paste it into the sheet code module of the sheet where you want it to run. To access the sheet code module, right click the sheet name tab and then click 'View Code' in the pop up menu.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
     If Not Intersect(Target, Range("J:J")) Is Nothing And Target.Value = "" Then
        Target.Offset(, -8).Resize(1, 8).ClearContents
     End If
 End Sub

once installed, the code will run when any change is made in column J, but will only execute the ClearContents if the changed cell is blank.

 

[CMcColm]

That's awesome! Thank you so much!

Is there a way to make this applicable to all sheets in the workbook without putting it on each sheet individually? A work book currently relates to a month with each sheet to a day and I'm trying to keep the file as small as possible.

 

[JLGWhiz]

That's awesome! Thank you so much!

Is there a way to make this applicable to all sheets in the workbook without putting it on each sheet individually? A work book currently relates to a month with each sheet to a day and I'm trying to keep the file as small as possible.

Take the old one out of the sheet code module. Copy this one to the ThisWorkbook code module. To access the ThisWorkbook code module, press Alt + f11 and double click on 'ThisWorkbook' in the small Projects pane at the upper left of the VBA Editor window.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
     If Not Intersect(Target, Range("J:J")) Is Nothing And Target.Value = "" Then
        Target.Offset(, -8).Resize(1, 8).ClearContents
     End If
 End Sub

 

[CMcColm]

This works brilliantly. The only issue I'm having with it is if I want to delete multiple cells in the column then the macro doesn't activate. it's fine deleting one at a time but if I want to highlight 2 or more cells in the column and delete then it won't delete any of the rows.
Any way to fix this?

 

[jim may]

The line. If Target.Cells.Count > 1 Then Exit Sub

is causing your problem. Right?

 

[CMcColm]

I've tried editing it so that people can't edit more than one cell at a time but I seem to be doing something wrong on it.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False

    If Target.Cells.Count > 1 Then
            MsgBox "Change only one cell at a time"
            Application.Undo
        If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Value = "" Then
            Target.Offset(, 2).Resize(1, 8).ClearContents
    End If
    
    Application.EnableEvents = True
End Sub

It keeps telling me "Block If without End If" and highlighting the first line. I'm not sure if it's to do with Target As Range or not.

 

[jim may]

You have 2 If statements, and only 1 End if statement.

 

[CMcColm]

There were always two If statements and the code works fine as is. It's just when trying to delete more than one cell in the column. I seem to be able to get the message box to work or the deletion as it was originally.

 

[jim may]

There were always two If statements and the code works fine as is. It's just when trying to delete more than one cell in the column. I seem to be able to get the message box to work or the deletion as it was originally.

Originally when you had 2 If statements, the 1st If statement line ended with Exit Sub. This is a complete statement and doesn't require and End if, ever.