Making certain cells editable after protecting the sheet

S

sameerce

Hi,

I have a Excel VBA application where on click of a command button ne
cells are inserted at predefined positions and the cells below ar
pushed down. I want to apply protection on the sheet such that the row
that are present earlier (i.e. before button click) are uneditable an
the new row that is inserted on each button click is only editable.

I know that this is possible when one knows the rows that are to b
marked as editable by Tools>Protection>Allow Users to Edit ranges.

Is there a way to do this programatically, such that the new ro
inserted is only editable and the remaining ones are still uneditable?

Thanks,
Samee
 
T

TroyW

Sameer,

Here is one approach. The code below will insert a new row and unlock it. It
will remember what row was previously inserted (using a defined Name) so
that when the next row is inserted it will lock the previously inserted row.

Troy

=====================================================
Sub Master()

'Logic to choose what RowNumber to insert next goes below...

'For example: Choose Row10.
subInsertRow lngRow:=10

'For example: Choose Row7.
subInsertRow lngRow:=7

'For example: Choose Row14.
subInsertRow lngRow:=14

End Sub

Sub subInsertRow(lngRow As Long)
Dim sName As String
Dim sRowPrev As String
Dim lngRowPrev As Long

'Unprotect the sheet.
ActiveSheet.Unprotect

'---Lock the previously inserted row.
sName = ActiveSheet.Name & "!nLastRowInserted"
If fcnNameExists(sName) Then
sRowPrev = ThisWorkbook.Names(sName).RefersTo
If Len(sRowPrev) > 1 Then
sRowPrev = Mid(sRowPrev, 2, Len(sRowPrev))
If IsNumeric(sRowPrev) Then
lngRowPrev = CLng(sRowPrev)
If lngRowPrev > 0 Then
ActiveSheet.Rows(lngRowPrev).EntireRow.Locked = True
End If
End If
End If
End If

'Insert a new row.
ActiveSheet.Rows(lngRow).EntireRow.Insert
'Change the entire row to Unlocked.
ActiveSheet.Rows(lngRow).EntireRow.Locked = False

'Save the number of the row that was inserted.
sName = ActiveSheet.Name & "!nLastRowInserted"
ThisWorkbook.Names.Add Name:=sName, RefersTo:="=" & lngRow

'Protect the sheet.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Function fcnNameExists(sName As String) As Boolean
Dim lngLen As Long

On Error Resume Next
lngLen = Len(ThisWorkbook.Names(sName).Name)
fcnNameExists = (Err.Number = 0)
On Error GoTo 0
End Function
=====================================================

Note: If you have a password on the sheet protection, you will need to
change:

ActiveSheet.Unprotect
-to-
ActiveSheet.Unprotect Password:="myPassword"
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top