VBA: How to replace (For...Each) With (Array)?

Question

Main Module

My code is working fine, the idea is to lock the entire row in the target workbook if source workbook cells in column b have a yellow color....

The question is how to replace the for-each loop with arrays for performance-wise, that's all?

  Sub LockYellow()
    
    
    
    With ThisWorkbook.Worksheets("Data")
    .Unprotect "007"
    .UsedRange.Locked = False
    .Range("a1:z1").Locked = True
    End With
    
    ' ---## Global
        Dim SourceBook As Workbook
        Set SourceBook = GetWorkbook(Source)
    
        
        
        Dim X, xrange As Range
        Set xrange = SourceBook.Worksheets("Data").Range("b2:b1499")
        
        For Each X In xrange
        
        'If X.Interior.Color = 65535 Then
      If X.value = "User_1" Then
        Dim u As String
        u = X.Address
        'ThisWorkbook.Worksheets("Data").Range(u).Value2 = SourceBook.Worksheets("Data").Range(u).Value2
        'ThisWorkbook.Worksheets("Data").Range(u).Interior.Color = 65535
        ThisWorkbook.Worksheets("Data").Range(u).EntireRow.Locked = True
        End If
        Next X


       If Not SourceBook Is Nothing Then
           SourceBook.Close savechanges:=False
    End If
    
    ThisWorkbook.Worksheets("Data").Protect "007"
    
    
    End Sub

Helper Module

  Public Const Source As String = "C:\Users\vv\Desktop\Sourcesheet.xlsx"

    Public Function GetWorkbook(ByVal sFullName As String) As Workbook
    
        Dim sFile As String
        Dim wbReturn As Workbook
    
        sFile = Dir(sFullName)
    
        On Error Resume Next
            Set wbReturn = Workbooks(sFile)
    
            If wbReturn Is Nothing Then
                Set wbReturn = Workbooks.Open(sFullName)
            End If
        On Error GoTo 0
    
        Set GetWorkbook = wbReturn
    
    End Function

What if I changed the logic from color to value, meaning that instead of checking the yellow color in the source sheet it will check a value i.e. "User_1". \then get the address, then lock the same entirerow address in target sheet. — Zatary
– Zatary, Commented Dec 4, 2020 at 17:27

Zatary · Accepted Answer · 2020-12-04 20:30:08Z

2

Try this out:

Dim ws as Worksheet
Set ws = ThisWorkbook.Worksheets("Data")

Dim test as Range
Set test = SourceBook.Worksheets("Data").Range("b2:b1499")

Dim v As Variant
v = test.Value
    
Dim x as Long, rowLock as Range
For x = lbound(v) to ubound(v)
    
    If v(x,1) = "User_1"
        If rowLock is Nothing Then
           Set rowLock = ws.cells(x+1,test.column) 'x + 1 because range starts at row 2
        Else 
           Set rowLock = Union(rowLock,ws.cells(x+1,test.column))
        End If
    End If
Next

If not rowLock is Nothing Then rowLock.EntireRow.Locked = True

edited Dec 4, 2020 at 20:30

Zatary

898 bronze badges

answered Dec 4, 2020 at 17:38

Scott Holtzman

27.3k5 gold badges42 silver badges76 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Zatary Over a year ago

Thanks a million :D

Collectives™ on Stack Overflow

VBA: How to replace (For...Each) With (Array)?

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related