开发者

Prevent user from deleting certain rows based on contents of a cell in that row

开发者 https://www.devze.com 2023-04-13 05:41 出处:网络
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

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
0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号