Locking Cells using VBA

Question

I have a VBA Code to Lock cells which is not working as desired.

In cell Range I9 to BI9 I have values which are Lock/Unlock. So based on these values, where ever the value Lock, it should lock the range I9 to I300.

In cell range B21 to B300, I have values Lock/Unlock. Based on these values where ever the value Lock, it should lock the row from I21 to BI21.

Problem I am facing is either the rows would get locked or columns. It does not work in coordination.

I want it to work as tabulated:

Row     Column  Value
Lock    Lock    Locked
Lock    Unlock  Locked
Unlock  Lock    Locked
Unlock  Unlock  Unlocked

Here is my code.

Private Sub Workbook_Open()    
Dim sh As Object
Dim sheetnames As String
Dim i As Integer
Dim col As Range
Dim rng As Range: Set rng = Application.Range("I16:BI16")    
Application.ScreenUpdating = False    
    For Each sh In Sheets   'First Each
        If sh.Name <> Warning Then  'Warning If
            sh.Visible = xlSheetVisible
                If sh.Name <> "Configuration" Then      'Configuration If
                    sheetnames = sh.Name
                    Worksheets(sheetnames).Activate
                    ActiveSheet.Unprotect Password:="xxx"
                    For Each col In rng.Columns
                        If col.Columns.Value = "Lock" Then
                            ActiveSheet.Range(Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "22:" & Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "300").Locked = True
                            ActiveSheet.Range(Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "22:" & Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "300").Font.Color = -16776961
                        Else
                            ActiveSheet.Range(Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "22:" & Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "300").Locked = False
                            ActiveSheet.Range(Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "22:" & Replace(Cells(1, col.Column).Address(0, 0), 1, "") & "300").Font.Color = vbBlack
                        End If
                    Next col
                    For i = 22 To 300   'Lock rows with Total and VAS activity
                        If sh.Range("B" & i).Value = "Lock" Then
                            sh.Range("I" & i & ":" & "BI" & i).Locked = True
                            sh.Range("C" & i & ":BI" & i).Font.Color = -16776961
                        Else
                            sh.Range("I" & i & ":BI" & i).Locked = False
                            sh.Range("C" & i & ":" & "BI" & i).Font.ColorIndex = xlAutomatic
                        End If
                    Next i
                End If                      'End of Configuration If
        End If              'End of Warning if
    Next sh     'End of First Each
ActiveSheet.Protect Password:="xxx"
Sheets(1).Select
End Sub

When you define `rng` you don't reference a sheet, which may be a problem, and your question refers to row 9 not row 16. — SJR, Nov 06 '17 at 10:58

Vityata · Answer 1 · 2017-11-06T11:20:08.340

Start from something really easy and try to make your code work. Then elaborate further. E.g., imagine that you have it like this:

"l" means "Locked" and "u" means "Unlocked". Instead of locking, you will be marking with the cells. Thus, a cell marked with "X" is unlocked, and a non marked cell is locked. Like this:

As you see, the only condition for the cells is to have both "u" on column and on row. This is easily translated to VBA. Like this:

Public Sub TestMe()

    Dim rngCell     As Range

    For Each rngCell In Range("B2:G5")
        If Cells(1, rngCell.Column) = "u" And Cells(rngCell.Row, 1) = "u" Then
            rngCell = "X"
        End If
    Next rngCell

End Sub

Once you see that the code works, you may start building it further. E.g., changing the "B2:G5" range and changing the rows and the columns number.

After this you can start trying for the whole columns and row as per your business logic. The tricky part is that you should loop twice, if they should be locked - the first time to do the check and the second time to do the lock. Like this:

Public Sub TestMe()

    Dim rngRow      As Range
    Dim rngCell     As Range
    Dim lockRow     As Boolean

    Range("B2:G5").ClearContents

    For Each rngRow In Range("B2:G5").Rows
        lockRow = False

        For Each rngCell In rngRow.Cells
            If Cells(1, rngCell.Column) = "l" Then lockRow = True
        Next rngCell

        If Cells(rngRow.Row, 1) = "l" Or lockRow Then
            For Each rngCell In rngRow.Cells
                rngCell = "X"
            Next rngCell
        End If

    Next rngRow

End Sub

Little modification to the first code helped me. However, Range B16:B300 and Range I16:BI16 have got the Lock and Unlock data. Since this code is reading through each cell in a sheet it takes a very long time. For a file with 15 Sheets. System will hang. Anything can be done to speed up the code? — Sankar Narayanan, Nov 06 '17 at 13:19
@SankarNarayanan - this will make it fly, but you need good understanding of arrays - https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba — Vityata, Nov 06 '17 at 13:21

Locking Cells using VBA

Here is my code.

1 Answers1