unable to set the locked property of the range class
Try this code. This code will test if the cell being analyzed is merged with
other cells, and if there is something in the merged area it will lock all
rows in that merged area. Hope this helps! If so, let me know, click "YES"
below.
Option Explicit
Sub LockRows()
Dim wks As Worksheet
Dim LastRow As Long
Dim rw As Long
Dim MyRange As Range
For Each wks In Worksheets
With wks
.Unprotect Password:="MyPass"
.Cells.Locked = False
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For rw = 2 To LastRow
Set MyRange = .Cells(rw, "A").MergeArea
If MyRange.Rows.Count = 1 Then
If Trim(.Cells(rw, "A").Value) < "" Then
.Rows(rw).Locked = True
End If
Else
If Trim(MyRange.Value2(1, 1)) < "" Then
MyRange.EntireRow.Locked = True
End If
End If
Next rw
.Protect "MyPass", DrawingObjects:=False, Contents:=True,
Scenarios:= _
True, AllowFormattingCells:=True,
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True,
AllowFiltering:=True
'.Protect Password:="MyPass"
End With
Next wks
End Sub
--
Cheers,
Ryan
"Steve" wrote:
I'm sorry, I got a phone call I'd needed to take, and posted this before I
was done.
you can slap my hand now....
Where the error arises is at:
.Rows(rw).Locked = True
"Steve" wrote:
Sub LockRows()
Dim wks As Worksheet
Dim LastRow As Long
Dim rw As Long
For Each wks In Worksheets
With wks
.Unprotect Password:="MyPass"
.Cells.Locked = False
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For rw = 2 To LastRow
If Trim(.Cells(rw, "A").value) < "" Then
.Rows(rw).Locked = True
End If
Next rw
.Protect "MyPass", DrawingObjects:=False, Contents:=True,
Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows :=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting _
:=True, AllowFiltering:=True
'.Protect Password:="MyPass"
End With
Next wks
End Sub
|