One time permission to edit cell & save in excel

Possibly this will do as you wish...
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)    
    Const PW As String = "9999"
    Dim Response As String
    
    If Target.Address = "$A$1" Then
        If Target.Value <> "" Then
            Response = InputBox("Enter password to edit cell")
            If Response <> PW Then Target.Offset(1).Select
        End If
    End If
End Sub
 
Your

If Target.Value <> "" Then ...

wastes time and nerves of Visual Basic interpreter by needless comparing a variant (!!!) with string. Why?

1. Learn to use the Text property - it directly returns string
2. Don't slowly compare strings when you can quickly test a longinteger (zero or not):

If LenB(Target.Text) Then ...
 
Hi All,

Presently i am having below code which works a part my activity. what below code does is, once we enter a data in "B2" cell or any cell between rage provided below and moves to 2nd cell the data which is entered in 1st cell gets protected automatically. and to edit the cell i need to unprotect it.


This were i need you guys help, i want the cell to get protected once i click Save button.

I have attached the sample of excel sheet were the code is present.

Please support me .

Coding below:

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Protect userinterfaceonly:=True
Set CellsToLock = Intersect(Target, Range("B2:B10,D2:D5,F2,H2"))
If Not CellsToLock Is Nothing Then
For Each cll In CellsToLock.Cells
cll.Locked = True
Next cll
End If
End Sub
 

Attachments

  • ExcelGuru6988 (1).xlsm
    12.8 KB · Views: 23
Last edited:
Hi Jan Mach,

Are you good in VBA coding. if possible please help me in my activity.

I am breaking my head here :(
 
Hi Jan Mach,

Are you good in VBA coding. if possible please help me in my activity.

I am breaking my head here :(
 
Try adding the line...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Me.Protect userinterfaceonly:=True
[I][B]    Me.EnableSelection = xlUnlockedCells[/B][/I]
    Set CellsToLock = Intersect(Target, Range("B2:B10,D2:D5,F2,H2"))
    If Not CellsToLock Is Nothing Then
        For Each cll In CellsToLock.Cells
            cll.Locked = True
        Next cll
    End If
End Sub
 
I expect CellsToLock to be a temporary range; then declare it as a variable in the Worksheet_Change event:
Dim CellsToLock As Range, cll As Range
Or, do you so much love the work with robust and gawky Variant variables?

More: The event code can be considerably reduced:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Protect UserInterfaceOnly:=True    [I]'Why the [B]Me[/B] prefix when you are in the sheet-module code?[/I]
EnableSelection = xlUnlockedCells

[B]Set Target = Intersect(Target, Range("B2:B10,D2:D5,F2,H2"))[/B]    [I]'You use Target for the intersection only and [/I][I]it is a [/I][B][I]ByVal[/I][/B][I] parameter;[/I][I] you can use it as a variable then[/I]
[B]If Not Target Is Nothing Then Target.Locked = True[/B]    [I]'You can lock the whole range at a stroke[/I]
End Sub

And More: Experienced programmers hate constructions like Range("B2:B10,D2:D5,F2,H2") which are sooo beloved in this forum. They know pretty well that any change in the sheet design (like deleting/inserting cells/rows/columns) would make them to snoop through the code and change these awful addresses. The standard idea is to use named ranges:

Give any name (say, toLck) to your range B2:B10,D2:D5,F2,H2; then the code will be

Code: 
Set Target = Intersect(Target,[B] [toLck][/B])
If Not Target Is Nothing Then Target.Locked = True

or, if you are not scared of an intentional error raising, you can replace these lines with

Code: 
[B]On Error Resume Next[/B]
Intersect(Target,[toLck]).Locked = True
 
Or... to suggest a solution for the question the OP asked

put this in the sheet module
Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B2:B10,D25,F2,H2")) Is Nothing Then
        If Len(Target.Value) > 0 Then
            joinstr = joinstr & Chr(124) & Target.Address
        Else
            joinstr = Replace(joinstr, Chr(124) & Target.Address, "")
        End If
    End If
End Sub

Put this in a regular module and link your save button to it.
Code: 
Option Explicit
Public joinstr As String

Sub TheButtonClick()
    Dim arr, i As Integer
    Dim lockrng As Range
    
With Sheets("Sheet1")
    If Len(joinstr) > 0 Then
        arr = Split(Mid(Replace(joinstr, "$", ""), 2), Chr(124))
        Set lockrng = .Range(arr(0))
        If LBound(arr) <> UBound(arr) Then
            For i = 1 To UBound(arr)
                Set lockrng = Union(lockrng, .Range(arr(i)))
            Next i
        End If
    End If
    .Unprotect
    lockrng.Locked = True
    .Protect
End With

joinstr = ""
ActiveWorkbook.Save

End Sub
 
You must log in or register to reply here.
Back
Top