• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Autolock plus autosave

N

nimerod

New Member
Hello guys,

Its nice to join your community and I hope to learn a great deal!


I have a little problem setting up a project.


I built a Log, a radio network log. So in my F5:F$ range I will log what is said on said Net. Therefore I want the last modified cell to be locked, workbook saved, after en entry was made whilst having the next available cell open to modification and so on so forth. I work around a few thing I learned on Chandoo but nothing!


I found this piece that help a little.


VB:private Sub Worksheet_Change(ByVal Target As Range)

Dim MyRange As Range


Set MyRange = Intersect(Range("A1:D100"), Target)

If Not MyRange Is Nothing Then

Sheets("Sheet1").Unprotect password:="blabla"

MyRange.Locked = True

Sheets("Sheet1").Protect password:="blabla"

ThisWorkbook.Save

ActiveCell.Offset(1, 0)


End If

End Sub


Thank you very much


Nimerod
 
I think this is at least close to what you are looking for. Note that this should be installed in the ThisWorkbook module, since it's using the Workbook_Close event.

[pre]
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim mySheet As String

'Worksheet password
Const myPass = "1234"

'What sheet are we looking at?
mySheet = "Sheet1"

With Worksheets(mySheet)
.Unprotect myPass
'Last cell gets locked
.Range("F5").End(xlDown).Locked = True

'Next cell gets unlocked
.Range("F5").End(xlDown).Offset(1, 0).Locked = False
.Protect myPass
End With

'Save the workbook
ThisWorkbook.Save

End Sub
[/pre]
 
Hey thanks for the replie.


I have a "Object related" error and the Debuger pops up on line :


.Range("F5").End(xlDown).Offset(1, 0).Locked = False


I was thinking of putting a condition


If

.Range("F5").End(xlDown).Offset(1, 0)="" Then


What do you think? Could this solve the issue?


Right now I<ve been set back to scrap. The only thing I manage to get working is the After cell mod, autosave and protect...


Thank you


Nimerod
 
You could try, but I suspect the error is being caused by XL going to bottom row on worksheet and then trying to go 1 more cell down (which is impossible).

In which case, rather than starting at top and going down, lets start at bottom and look up like so:

[pre]
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim mySheet As String

'Worksheet password
Const myPass = "1234"

'What sheet are we looking at?
mySheet = "Sheet1"

With Worksheets(mySheet)
.Unprotect myPass
'Last cell gets locked
.Cells(.Rows.Count, "F").End(xlUp).Locked = True

'Next cell gets unlocked
.Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Locked = False
.Protect myPass
End With

'Save the workbook
ThisWorkbook.Save

End Sub
[/pre]
 
Nice it works! BUT! ;)

As stated ( I think) in your code) it works only once after a Save and Close.

because that is what it does right now. I would need it as an instant refresh.


Thank you so much
 
I added something in the WorkSheet module,


But I am missing the knowledge to fix my bug. But I got close.


VB: Private Sub WorkSheet_Change(ByVal ActiveCell As Range)

If ActiveCell>"" Then Exit Sub

ActiveSheet.Unprotect Password:="1234"

With ActiveCell>""

ActiveCell.Locked=True

ActiveCell(xlDown).Offset(1, 0).Locked= False

ActiveCell(xlDown).Offset(1, 0).Select

End With

ActiveSheet.Protect password:="1234"

ThisWorkbook.Save

End If

End Sub


Now it bugs at : END If saying theres is no If Block to End... I thought I was there though!
 
Hi, nimerod!

Shouldn't you change the two "With" occurrences by "While" and "Wend" respectively?

And the line "End If", which If statement closes? If the first and only one, you should try changing the code to this:

-----

[pre]
Code: 
Option Explicit

Private Sub WorkSheet_Change(ByVal ActiveCell As Range)
If ActiveCell > "" Then
Exit Sub
Else
ActiveSheet.Unprotect Password:="1234"
While ActiveCell.Locked = True
ActiveCell(xlDown).Offset(1, 0).Locked = False
ActiveCell(xlDown).Offset(1, 0).Select
Wend
ActiveSheet.Protect Password:="1234"
ThisWorkbook.Save
End If
End Sub
[/pre]
-----

Regards!

PS: To avoid compilation errors is always a good practice to include a first line in each module like "Option Explicit" that will oblige to define every constant, variable and object used.

PS2: Before running a macro you might check for compilation errors from the Depuration tab, Compile VBA Project option.
 
It works!


Thanks guys!


Should I add a line that would help the refresh rate? What I mean is this whole thing is not instant. So when I mod a cell, then enter or click away. Excel is not ready to repeat the process right away.


Can I force it to alway be on the watch? Force start the Macro process?
 
Hi ,


I haven't really participated in the discussion , but have you tried this ?

[pre]
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "" Then Exit Sub
If Target.Count > 1 Then Exit Sub
ActiveSheet.Unprotect Password:="1234"
Target.Locked = True
ActiveSheet.Protect Password:="1234"
ThisWorkbook.Save
End Sub
[/pre]
Narayan


P.S. I forgot to mention that prior to implementing this macro , select the entire worksheet and unlock all cells , by unchecking the Locked checkbox in the Protection tab , in the Cell Format dialog box.
 
Hi, nimerod!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

Regarding your new question, a priori it shouldn't be necessary since the worksheet change event is automatically triggered. If you find any synchronization issue, please upload a sample file to analyze it deeply.

Regards!
 
Hey Narayan! Thank you man it worked even better! It solve the instant refresh issue I was speaking off.


SO I take it that with LUKE M's code in the Workbook module and yours in the Sheet' it is now fast and efficient. Thanks
 
You must log in or register to reply here.
Back
Top