Restricting data entry in a table, one row at a time
Good morning!
I need assistance restricting data entry to a table. I am working with a 32-line table (Range("A38:Y69")). I want to prevent subsequent rows from being filled with data accidentally before the first row is signed off on by a manager. This is the sequence of events I am trying to work out:
The first row (Row 38) is unlocked; Rows 39-69 are locked.
Manager clicks on the last column of the first row, Y38, for sign-off.
If sign-off is approved, the second row (Row 39) is unlocked while Row 38 is locked.
And so forth until Row 69.
By the way, I incorporated the code from the article, "Protect cell or cells on sheet without protecting sheet", in Range("Y38:Y69").
I think you want something like this, but I've not checked all your protection etc.
[VBA]Private Sub CmndSubmit_Click()
If UserForm1.TextBox1 <> "Password" Then ''''if the password does not match "Password"
MsgBox "Incorrect Password", vbOKOnly, "Warning"
OriginalCell.Select ''''then select this cell, this cell is set in the worksheet module
Unload Me '''''close the userform
Else
ProtectedCell.Select '''Set in the WorkSheet module
'Indicate signature
ProtectedCell = "OK"
'Lock all cells
Range("A38:Z69").Locked = True
rw = ProtectedCell.Row + 1
'Unlock next row
Range("A" & rw).Resize(, 26).Locked = False
'Lock sheet
ActiveSheet.Protect "xxx"
Unload Me '''''close the userform
Application.EnableEvents = True
End If
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Thank you for the salutations and your response, mdmackillop.
When I start the spreadsheet, I keep receiving this notification:
Run-time error '9':
Subscript out of range
and this was what debug showed me was the problem:
[vba]Private Sub Workbook_Open()
Sheets("Sheet1").Visible = True 'Problem line; highlighted by debug whenever I open or close the spreadsheet
End Sub[/vba] I added your code segment to my spreadsheet. I populated the first row (Row 38) with data and completed the sign-off. Most of the objectives I laid out were achieved...for the first row.
I attempted to populate the second row (Row 39) with data. When I filled the Operation field with too much data, the "wrap text" code failed to trigger and I received this alert:
Run-time error '1004':
Unable to set the MergeCells property of the Range Class
and this was what debug showed me was the problem:
[vba]Private Sub Worksheet_Change(ByVal Target As Range)
.
.
With Target
If .MergeCells And .WrapText Then
.
.
For Each cc In ma.Cells
.
.
ma.MergeCells = False 'Problem line
.
.
End If
End With[/vba]
When I attempted to type a password at the end of the second line (Y39), I received this alert:
Run-time '1004':
Unable to set the Locked Property of the Range Class
and this was what debug showed me was the problem:
[vba]Private Sub CmndSubmit_Click()
If UserForm1.TextBox1 <> "Password" Then
.
.
Else
.
.
Range("A38:Z69").Locked = True 'Problem line, although it worked at first
.
.
End If
End Sub[/vba]
I also did a test on where I can start entering data. Even though the first row (Row 38) is supposed to be the only row anyone can start entering data, any row where I started up to the penultimate row (Row 68) acted like the first row of the table. How can I restrict data entry to the very first line only when the spreadsheet is first opened and, ostensibly, empty?
Sheet 1 has been renamed, you need to modify the code accordingly
Try
[VBA]Private Sub Workbook_Open()
Sheets(1).Visible = True '''If macro's are allowed to run then the sheet is visible again
End Sub[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Resume Next is fine if you handle the error, such as
[VBA] Sub GetData()
On Error Resume Next
Range("IV1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
If Err <> 0 Then
MsgBox Err.Description
Exit Sub
End If
On Error GoTo 0
Cells(1, 1).Select
End Sub
[/VBA]
FYI, there is no need to select a range in which to paste, just identify the top left cell of the target range.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Silly me, that was a detail I sheepishly missed. Good eye! I made the changes to the reference of the sheet name, both of which were found in "ThisWorkbook".
Okay, so that solves run-time error '9'. Unfortunately, the other two errors still remain and are still reproducible.
Where should I place GetData()?
(Sorry, VBA is still a foreign language I am slowly learning.)
I believe I got ahead of myself by desiring the use of authentication before getting down table access restriction correctly. Let me restate the (modified) objectives:
I have a table, Range("A38:Y69"). The entire table is locked and devoid of data.
A check is done on Range("Y38:Z38"). If it is blank, the first row of the table is unlocked. However, the "row" is a non-contiguous range of cells, and this is Range("B38:K38,M38:T38,V38,Y38:Z38").
I would like my boss to be able to write his signature in Range("Y38:Z38") if and only if the contents of Range("B38:K38,M38:T38,V38") are not empty. This, of course, would catch the employees who do not fill out the table completely as they are supposed to.
If that row is full of data, then my boss can sign off on the first row in Range("Y38:Z38").
I need the action of pressing the Enter Key on the keyboard while in Range("Y38:Z38") to:
Lock Range("B38:K38,M38:T38,V38,Y38:Z38").
Unlock Range("B39:K39,M39:T39,V39,Y39:Z39").
Set the focus on Range("B39").
And so forth until Range("B69:K69,M69:T69,V69,Y69:Z69").
May I please have some help in constructing a loop structure, such as a FOR loop, so that I can unlock each row and the range of cells therein?
My code is woefully incomplete. Any help would be greatly appreciated. Thanks so much in advance!
[vba]Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim i, j As Integer
For Each c In Range("B38:K38,M38:T38,V38")
If IsEmpty(c) Then
MsgBox ("Blank cells")
Exit Sub
Else
ActiveSheet.Cells(i, 25).Locked = False
End If
Next c
Reply With Quote
Good eye! I made the changes to the reference of the sheet name, both of which were found in "ThisWorkbook".
