CODEWITHSUNDEEP
excelvba
Jiaxin He
Jiaxin He

Reputation: 11

Protect worksheets in loop

The following code is to lock cells that meet the criteria in each worksheet of the workbook. The code works fine on single worksheet, but when I want to apply to the entire workbook, the error messgage "unable to set the locked property to the range class".

The workbook loop procedure is also correct, can someone tell me what is causing the error?

Much appreciated! Code as below and I'm sorry I don't know how to display the correct format here:

Sub selectnumbers()
    Dim ws_count As Integer
    Dim n As Integer
    ws_count = ActiveWorkbook.Worksheets.Count
    For n = 2 To ws_count

        Dim rng As Range
        Dim cell As Range
        Dim i As Range
        Set rng = Nothing

        For Each cell In ActiveSheet.UsedRange
          If IsNumeric(cell) = False Or cell.Interior.Pattern = xlLightUp Or cell = "" Then
           If rng Is Nothing Then
            Set rng = cell
              Else
              Set rng = Application.union(rng, cell)
            End If
          End If
        End If
        Next cell

        If Not rng Is Nothing Then
        rng.Select
        End If

        Selection.Locked = True

        ActiveSheet.Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

    Next n

End Sub

Upvotes: 1

Views: 123

Answers (2)

brettdj
brettdj

Reputation: 55692

The cell by cell testing looked slow to me, so I've tried a version below using SpecialCells and Find to speed it up.

Sub selectnumbers()
    Dim ws_count As Long, n As Long
    Dim rng As Range
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strAddress As String

    ws_count = ActiveWorkbook.Worksheets.Count
    For n = 2 To ws_count
        With Worksheets(n)

            Set rng = Nothing
            .UsedRange

            On Error Resume Next
            Set rng = .UsedRange.SpecialCells(xlBlanks)
            If Not rng Is Nothing Then
                Set rng = Union(rng, .UsedRange.SpecialCells(xlCellTypeFormulas, 22))
            Else
              Set rng = .UsedRange.SpecialCells(xlCellTypeFormulas, 22)
            End If
            On Error GoTo 0


            With Application.FindFormat
                    .Clear
                    .Interior.Pattern = xlLightUp
            End With

            Set rng1 = .UsedRange.Find(vbNullString, , xlFormulas, xlPart, xlByRows, xlNext, , True)
            If Not rng1 Is Nothing Then
                strAddress = rng1.Address
                Set rng2 = rng1
                Do
                    Set rng1 = .UsedRange.Find(vbNullString, rng1, xlFormulas, xlPart, xlByRows, xlNext, , True)
                    Set rng2 = Union(rng2, rng1)
                Loop Until rng1.Address = strAddress
            Set rng = Union(rng, rng2)
            End If

            If Not rng Is Nothing Then rng.Locked = True

            .Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
        End With
    Next n

End Sub

Upvotes: 0

user4039065
user4039065

Reputation:

There seemed to be an extra End If just before the close of the nested For Each cell In .UsedRange.

I believe your primary problem was relying on the ActiveSheet property. The For n = 2 To ws_count wasn't really passing control over to the next worksheet. Focus and control was remaining with the ActiveSheet.

Sub selectnumbers()
    Dim ws_count As Long, n As Long
    Dim rng As Range, cell As Range, i As Range

    ws_count = ActiveWorkbook.Worksheets.Count
    For n = 2 To ws_count
        With Worksheets(n)

            Set rng = Nothing

            For Each cell In .UsedRange
                If Not IsNumeric(cell) Or cell.Interior.Pattern = xlLightUp Or cell = "" Then
                    If rng Is Nothing Then
                        Set rng = cell
                    Else
                        Set rng = Application.Union(rng, cell)
                    End If
                End If
            Next cell

            If Not rng Is Nothing Then
                rng.Locked = True
            End If

            .Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

        End With
    Next n

End Sub

I've used a With ... End With statement to pass control along to the next worksheet.

Upvotes: 2

Related Questions