Array in VBA + Excel

Question

I have written a macro, which should read the value in every sheet (Row and Column) based on the value given it should Lock the cell or leave it unlocked. The way the code is written right now it takes forever to compute. I was suggested it be done using arrays. However the array are also not working

My excel file has got 15 sheets. My Code is below.

Private Sub Workbook_Open()

    Dim sh As Object
    Dim sheetnames As String
    Dim i As Integer
    Dim col As Range
    Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
    Dim rngCell As Variant

    Application.ScreenUpdating = False

        For Each sh In Sheets 'First Each

            If sh.Name <> "Configuration" Then 'Configuration If
                sheetnames = sh.Name
                Worksheets(sheetnames).Activate
                ActiveSheet.Unprotect Password:="sos"

                For Each rngCell In Range("I22:BI300")

                    If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
                        rngCell.Locked = True
                        rngCell.Font.Color = -16776961
                    Else
                        rngCell.Locked = False
                        rngCell.Font.ColorIndex = xlAutomatic
                    End If

                Next rngCell

                ActiveSheet.Protect Password:="sos"
            End If 'End of Configuration If

        Next sh 'End of First Each

    Sheets(1).Select

End Sub

Based on a combination of values in Column and Rows the result should produce values.

Column  Row Value
Lock    Lock    Lock
Unlock  Lock    Lock
Lock    Unlock  Lock
Unlock  Unlock  Unlock

It seems like this belongs in Code Review, since your code is working (Very slowly) Here is the website explanation for Code Review: (Your question must contain code that is already working correctly, and the relevant code sections must be embedded in the question. Please avoid stripping out key details that may be relevant to the review. If your code is incomplete or not working, you should ask for help on another site.) My suggestion would be: Try testing the code with a Do Loop (If possible) and see if that is faster than the For Next. — Elias Wick
– Elias Wick, Commented Nov 15, 2017 at 11:56
I modified the original code formatting to make it more readable, I hope you don't mind. — Elias Wick
– Elias Wick, Commented Nov 15, 2017 at 12:02

Tom · Accepted Answer · 2017-11-15 11:59:42Z

I'm not sure how arrays would speed this up as really it is the locking/unlocking of cells which is causing the main speed issue (Although arrays could improve the read time). Anyway, I'd suggest setting the values you wish to lock/unlock to a range and then doing them all in one go instead of individually as that will be where your main performance impact is.

Private Sub Workbook_Open()
    Dim sh As Object
    Dim sheetnames As String
    Dim i As Integer
    Dim col As Range, LockRng As Range, UnLockRng As Range
    Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
    Dim rngCell     As Variant
    Application.ScreenUpdating = False
        For Each sh In Sheets   'First Each
            ' Reset Ranges for each sheet
            Set LockRng = Nothing
            Set UnLockRng = Nothing

            If sh.Name <> "Configuration" Then      'Configuration If
                sheetnames = sh.Name
                Worksheets(sheetnames).Activate
                ActiveSheet.Unprotect Password:="sos"
                For Each rngCell In Range("I22:BI300")
                    If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") _
                        Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") _
                        Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
                            ' Create LockRng
                            If LockRng Is Nothing Then
                                Set LockRng = rngCell
                            Else
                                Set LockRng = Union(LockRng, rngCell)
                            End If
                    Else
                        ' Create UnLockRng
                        If UnLockRng Is Nothing Then
                            Set UnLockRng = rngCell
                        Else
                            Set UnLockRng = Union(UnLockRng, rngCell)
                        End If
                    End If
                Next rngCell
                ActiveSheet.Protect Password:="sos"
            End If                      'End of Configuration If
            ' Lock all cells in LockRng
            If Not LockRng Is Nothing Then
                LockRng.Locked = True
                LockRng.Font.Color = -16776961
            End If
            ' Unlock all cells in UnLockRng
            If Not UnLockRng Is Nothing Then
                UnLockRng.Locked = False
                UnLockRng.Font.ColorIndex = xlAutomatic
            End If
        Next sh     'End of First Each
    Sheets(1).Select
End Sub

If it doesn't stop at any line then how does it give a Run time error?

Collectives™ on Stack Overflow

Array in VBA + Excel

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related