Deleting selected row only if column C is blank

[rjheibel]

I currently have code to add a item to the right click menu to allow a user to delete a row in a password protected sheet, as the Delete option is grayed out.

I would like to amend this code to only allow the deletion of the selected row/rows if column C in the selected rows does not contain a value. If column c does contain a value, a message should appear to let the user know that row can not be deleted. Current code is listed below. Any Help would be greatly appretiated.

Thanks

Public Sub deleteRow()


Application.EnableCancelKey = xlDisabled
Dim ws As Worksheet
On Error Resume Next
Set ws = ActiveWorkbook.Sheets("LookAhead Schedule")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Function Only Works in LookAhead Sheet!!!"
Else
If ws.Name = ActiveWorkbook.ActiveSheet.Name Then
ActiveSheet.Unprotect "password"
On Error Resume Next
ActiveSheet.ShowAllData
Selection.EntireRow.Delete
ActiveSheet.Protect _
Password:="password", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True
Else
MsgBox "Function Only Works in LookAhead Sheet!!!"
End If
End If
Application.EnableCancelKey = xlInterrupt
End Sub

 

[Norie]

Try this.

Public Sub deleteRow()
Dim ws As Worksheet
Dim cl As Range


    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    Set ws = ActiveWorkbook.Sheets("LookAhead Schedule")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "Function Only Works in LookAhead Sheet!!!"
    Else
        If ws.Name = ActiveWorkbook.ActiveSheet.Name Then
            ActiveSheet.Unprotect "password"
            On Error Resume Next
            ActiveSheet.ShowAllData

            For Each cl In Selection.Cells
                With cl
                    If .EntireRow.Cells(1, "C").Value = "" Then
                        .EntireRow.Delete
                    Else
                        MsgBox "Row " & cl.Row & " can't be deleted!"
                    End If
                End With
            Next cl

            ActiveSheet.Protect _
                    Password:="password", _
                    DrawingObjects:=True, _
                    Contents:=True, _
                    Scenarios:=True, _
                    AllowFiltering:=True
        Else
            MsgBox "Function Only Works in LookAhead Sheet!!!"
        End If
    End If

    Application.EnableCancelKey = xlInterrupt

End Sub

 

[rjheibel]

Norie, Thanks for your quick reply!

Your code almost got it. It will successfully delete rows in which column C is blank, and does not allow deleting and brings up the dialog box when it is not. Problem now id the dialog box will not exit when you click "ok" or the "X" on the dialog box. Excel is also frozen as if it is not exiting the macro. Any Suggestions?

 

[Norie]

Which 'dialog' box are you referring to?

 

[rjheibel]

"Row # Can't be delete!"

 

[rjheibel]

Norie, in the code you provided, Once the program gets to a range that doesn't encounter a value in Column C, is it in a continuous loop due to the Next cl command? How would I get the program to stop the loop once it finds the Else condition and displays the msgbox?

            For Each cl In Selection.Cells
                With cl
                    If .EntireRow.Cells(1, "C").Value = "" Then
                        .EntireRow.Delete
                    Else
                        MsgBox "Row " & cl.Row & " can't be deleted!"
                    End If
                End With
            Next cl</pre>

 

[Rick Rothstein]

Assuming there are no formulas in Column C, here is another macro that you can try which I think will work correctly for you...

[table="width: 500"]
[tr]
	[td]Sub DeleteSelectedRowsIfColumnCisEmpty()
  Dim SelRows As Range, CBlanks As Range, IntersectedCells As Range
  Set SelRows = Selection.EntireRow
  Set CBlanks = Columns("C").SpecialCells(xlBlanks)
  Set IntersectedCells = Intersect(SelRows, CBlanks)
  If Intersect(Columns("C"), SelRows).Count <> IntersectedCells.Count Then
    MsgBox "One or more cells in Column C are not blank for selected rows!" & vbLf & vbLf & "Operation cancelled!", vbCritical
  Else
    IntersectedCells.EntireRow.Delete
  End If
End Sub[/td]
[/tr]
[/table]

 

[rjheibel]

Rick,

How would I add this to my original code to first check to make sure they are in the sheet that will allow the delete row function. My original code is below.

Public Sub deleteRow()

    Application.EnableCancelKey = xlDisabled
 Dim ws As Worksheet
 On Error Resume Next
 Set ws = ActiveWorkbook.Sheets("LookAhead Schedule")
 On Error GoTo 0
 If ws Is Nothing Then
     MsgBox "Function Only Works in LookAhead Sheet!!!"
 Else
     If ws.Name = ActiveWorkbook.ActiveSheet.Name Then
        ActiveSheet.Unprotect "test2"
        On Error Resume Next
        ActiveSheet.ShowAllData
        Selection.EntireRow.Delete
        ActiveSheet.Protect _
            Password:="test2", _
            DrawingObjects:=True, _
            Contents:=True, _
            Scenarios:=True, _
            AllowFiltering:=True
     Else
         MsgBox "Function Only Works in LookAhead Sheet!!!"
     End If
 End If
    Application.EnableCancelKey = xlInterrupt

End Sub

 

[rjheibel]

Rick, Not sure why I couldn't get your code to work the first time, but I was able to add it into my code successfully! THANKS SO MUCH FOR THE HELP!
Below is a copy of my final code that first checks to make sure that the user is in the correct sheet and then allows the deletion of a row if column C is blank.

Public Sub deleteRow()
 Application.EnableCancelKey = xlDisabled
 Dim ws As Worksheet
 Dim SelRows As Range, CBlanks As Range, IntersectedCells As Range
 
 On Error Resume Next
 Set ws = ActiveWorkbook.Sheets("LookAhead Schedule")
 Set SelRows = Selection.EntireRow
 Set CBlanks = Columns("C").SpecialCells(xlBlanks)
 Set IntersectedCells = Intersect(SelRows, CBlanks)
 
 On Error GoTo 0
     If ws.Name = ActiveWorkbook.ActiveSheet.Name Then
        ActiveSheet.Unprotect "test2"
        On Error Resume Next
        ActiveSheet.ShowAllData
          If Intersect(Columns("C"), SelRows).Count <> IntersectedCells.Count Then
            MsgBox "One or more cells in Column C are not blank for selected rows!" & vbLf & vbLf & "Operation cancelled!", vbCritical
          Else
            IntersectedCells.EntireRow.Delete
            ActiveSheet.Protect _
                Password:="test2", _
                DrawingObjects:=True, _
                Contents:=True, _
                Scenarios:=True, _
                AllowFiltering:=True
          End If
     Else
         MsgBox "Function Only Works in LookAhead Sheet!!!"
     End If
 Application.EnableCancelKey = xlInterrupt
End Sub