Pause/Delay to Import Data, then Apply Protection to Sheet

[ryguy7272]

Just wondering if there is a way to load info into a worksheet, then pause
for a few moments, and then apply protection to a specific sheet so users
can’t delete rows in this sheet. I can’t import the information with
protection on the sheet. I looked though many helpful topics on this DG, but
the answer is eluding me.


I have code in a module that loads the data into the sheet. I placed a
Private Sub behind the worksheet itself. Below is the code that I was
mulling over; doesn’t seem to do what I wanted it to do. Does anyone have
any ideas as to how to proceed? Excel may not permit this activity. I can't
tell for sure...


Private Sub my_Procedure()

Application.OnTime Now + TimeValue("00:00:10"), "my_Procedure"

ActiveSheet.Protect DrawingObjects:=False, Contents:=True,
Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True,
AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True


End Sub

 

[Vergel Adriano]

maybe something like this

Private Sub my_Procedure()

'wait for 5 seconds
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 5)

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True,
AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

End Sub

 

[ryguy7272]

Great suggestion Vergel. I tried something similar yesterday, but it didn’t
work. I just tried your version today and this didn’t work either. I keep
getting the same error at this line:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

As far as I can tell, it is failing because the worksheet is
password-protected (immediately), and thus no changes can be made. I was
hoping to find a workaround that delays the protection from being applied for
like 2 seconds, or five seconds, or some such thing, so I can capture
information relevant to the last time the file was viewed, changed, modified,
whatever (this info. is recorded immediately after the file is opened). I am
trying to record this information when the user exits, and save it in a
(historical) list displaying info. relevant to everyone that has accessed the
file. Right now it works, without password-protection, but someone can ‘game
the system’ by deleting rows containing information of the users who accessed
the file.

Maybe this can’t be done in Excel… If anyone knows, and can offer a
suggestion, I’d really appreciate it.

Regards,
Ryan---

 

[ryguy7272]

After playing around with it for just a bit longer, I figured it out:

I used ActiveSheet.Unprotect, right after Sub Autpen(), then Excel did
the operation, and then, just before exiting the Sub, I reapplied Worksheet
protection.

PS, thanks to those who submitted the ideas for the =LSDate(),and the
=DocProps("last author"), and the =DocProps("last save time"), which I found
on earlier submissions to the DG.


See the code below...


Public RunWhen As Double
Public Const cRunIntervalSeconds = 1 '1 Second
Public Const cRunWhat = "Sub Locking"



Function LSDate()
LSDate = Application.Caller.Parent.Parent. _
BuiltinDocumentProperties("Last Save Time").Value
End Function



Function DocProps(prop As String)
'-----------------------------------------------------------------
Application.Volatile
On Error GoTo err_value
DocProps = ActiveWorkbook.BuiltinDocumentProperties _
(prop)
Exit Function
err_value:
DocProps = CVErr(xlErrValue)
End Function


'and enter in a cell such as
'=DocProps ("last author")
'or
'=DocProps ("last save time")


Sub Autpen()

ActiveSheet.Unprotect

Application.ScreenUpdating = False

Sheets("Last Saved").Select

Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A3:C3").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select

Range("A2").Select
ActiveCell.FormulaR1C1 = "=DocProps(""last author"")"


Range("B2").Select
ActiveCell.FormulaR1C1 = "=LSDate()"


Range("C2").Select
ActiveCell.FormulaR1C1 = "=DocProps(""last save time"")"


Range("B2").Select
Selection.NumberFormat = "m/d/yyyy;@"
Range("C2").Select
Selection.NumberFormat = "[$-409]h:mm:ss AM/PM;@"

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
'-------------------------------------

Columns("A:C").Select

Selection.Sort Key1:=Range("B2"), Order1:=xlDescending,
Key2:=Range("C2") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
Range("A1").Select
'-------------------------------------
Application.ScreenUpdating = True

Range("A1").Activate

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True,
AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True


End Sub