VBA Code Adjustment for Auto-Locking Cells

Question

Hi,

I'm a complete novice at VBA code. I am designing a spreadsheet which will be used by "users" and "administrators". The users will be inputting data and administrators will approve that data (leaving a digital signature in the process). For this reason I've needed to design a protected spreadsheet where some cells are locked and others are not. However, in order to prevent users from changing their data after administrators approve it, I required some sort of auto-lock once the data has been added. I was looking up VBA code to achieve this and found the following:

Dim mRg ``As Range

Dim mStr ``As String

Private Sub Worksheet_BeforeDoubleClick(``ByVal Target ``As Range, Cancel ``As Boolean``)

If Not Intersect(Range(``"A1:F8"``), Target) ``Is Nothing Then

    ``Set mRg = Target.Item(1)

    ``mStr = mRg.Value

End If

End Sub

Private Sub Worksheet_Change(``ByVal Target ``As Range)

    ``Dim xRg ``As Range

    ``On Error Resume Next

    ``Set xRg = Intersect(Range(``"A1:F8"``), Target)

    ``If xRg ``Is Nothing Then Exit Sub

    ``Target.Worksheet.Unprotect Password:=``"123"

    ``If xRg.Value <> mStr ``Then xRg.Locked = ``True

    ``Target.Worksheet.Protect Password:=``"123"

End Sub

Private Sub Worksheet_SelectionChange(``ByVal Target ``As Range)

If Not Intersect(Range(``"A1:F8"``), Target) ``Is Nothing Then

    ``Set mRg = Target.Item(1)

     ``mStr = mRg.Value

End If

End Sub

I should point out this code DOES work quite well. However, what I'd like to have is a system where admins (who will have the password to unprotect the sheet) can amend any data in these special cells, which standard users cannot. Problem is that each time data is amended or deleted from that field, the sheet automatically re-protects itself. This means the admin would need to unprotect the sheet for EACH cell they want to change - not ideal if there's a large number of cells that need editing.

Is there a way around this, either by amending the code above or with new code? Essentially what would be needed is a way to prevent the code from re-locking the entire spreadsheet each time one of the targeted cells is edited by an admin. 

Thanks in advance for any help with this. If anything is unclear I'd be happy to clarify.

Jack

Answer 1

Hello Jack

I am V. Arya, Independent Advisor, to work with you on this issue. For admins (i.e. defined user names), you can bypass this statement by using a IF kind of statement.

Target.Worksheet.Protect Password:="123"

Answer 2

Too complicated. Replace all your code with the code below.

An Admin should select all cells that he has checked, then right-click the cells to lock them.

The code first checks if an Admin has clicked.

Then if we are at A1:F8

Then asks if the cells should be locked

That's much easier. And if an Admin like to right-click as usual: Just abort the MsgBox.

Andreas.

Option Explicit

Option Compare Text

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

  Dim Where As Range

  Select Case Application.UserName

    Case "Andreas Killer", "Jack Annand"

      'Continue, we are admins

    Case Else

      'Ignore, that's a user

      Exit Sub

  End Select

  'Are we at our cells?

  Set Where = Intersect(Target, Range("A1:F8"))

  If Where Is Nothing Then Exit Sub

  Select Case MsgBox("Lock this cells?", vbYesNoCancel + vbQuestion)

    Case vbYes

      'Abort the context menu

      Cancel = True

      Me.Unprotect "123"

      Where.Locked = True

      Me.Protect "123"

    Case vbNo

      Cancel = True

  End Select

End Sub