Prevent user from deleting certain rows based on contents of a cell in that row
I have a template file that I want to protect so that users cannot modify formulas. As the sheet is protected, I have written a macro to allow the user to insert rows. I also want a macro to allow the user to delete rows, but I want to prevent the user from deleting certain critical rows (e.g. check totals and headings, etc.).
To this end I have used column L in my template to identify rows that cannot be deleted. For these rows I have the word "keep"
in that row of column L. I have written a basic delete macro below but I need to modify it to look in column L of the selected range rRange
and Exit Sub
if the word开发者_如何学编程 "keep"
is there.
*Note that rRange
could contain a number of adjacent rows so the macro would need to exit if any of those rows fail the test.
Sub DeteteRows()
Dim rRange As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please use mouse to select a row to Delete.", _
Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
Else
rRange.EntireRow.Delete
Range("a1").Select
MsgBox ("Row(s) Deteted")
End If
End Sub
This may not be the best way but it is below. I did not add the delete portion in the last if then else as I figured you can handle that
Sub DeteteRows()
Dim rRange As Range
Dim bKeepFound As Boolean
bKeepFound = False
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please use mouse to select a row to Delete.", _
Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
'dont need the else statement cause you exit the sub if it fails
End If
For Each Row In rRange.Rows
Dim s 'variable to hold the array
s = Split(Row.Address, ":") 'split out the column and row
'remove the $ and convert to a number then check the cell value
If rRange.Cells(CInt(Replace(s(0), "$", "")), 12).Value = "keep" Then
bKeepFound = True
End If
Next Row
'check to see if a row was found to keep
If bKeepFound Then
Exit Sub 'row was found so exit sub
Else
'delete the rows in the range
End If
End Sub
精彩评论