CODEWITHSUNDEEP
excelvba
Zatary
Zatary

Reputation: 79

Loop declaring variables in arrays?

Part I No problem here

    Sub Get_Data_BYN()
    
    
            ' // Set Data Workplaces
                
                
                ' /  Set Data WorkBooks
            
                Dim SourceBook As Workbook
                Set SourceBook = GetWorkbook(Source)
                
                Dim TargetBook As Workbook
                Set TargetBook = ThisWorkbook
                
                
                ' /  Set Data WorkSheets
            
                Dim SourceSheet As Worksheet
                Set SourceSheet = SourceBook.Worksheets("Data")
                
                Dim TargetSheet As Worksheet
                Set TargetSheet = TargetBook.Worksheets("Sheet2")
                
                
                ' /  Set Data Ranges
                
                Dim SourceLastRow As Long
                SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
                
                Dim TargetLastRow As Long
                TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
                

    
                Dim Primary_Key As Variant '[SourceSheet Array Store]: LAVA ID
                Primary_Key = WorksheetFunction.Transpose(SourceSheet.Range("A2:A" & SourceLastRow).Value)
                
                Dim Foreign_Key As Variant '[TargetSheet Range Store]: LAVA ID
                Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value

Part II - Rest of code Where I need to loop through variants (for i = 1 to x) instead of (dim "variable" as variant every time), I need the full syntax as I am new to this topic... you can see below.

meaning that i want to loop through the variable itself, so that instead of writing the same procedure more than one time just loop through the same procedure.

                ' /  Set Data Fields
    
                    Dim Primary_Field_1 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_1 = WorksheetFunction.Transpose(SourceSheet.Range("B2:B" & SourceLastRow).Value)
                    
                    Dim Primary_Field_2 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_2 = WorksheetFunction.Transpose(SourceSheet.Range("C2:C" & SourceLastRow).Value)
                    
                    Dim Primary_Field_3 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_3 = WorksheetFunction.Transpose(SourceSheet.Range("D2:D" & SourceLastRow).Value)
                    
                    Dim Primary_Field_4 As Variant '[SourceSheet Array Store]: Bayan ID
                    Primary_Field_4 = WorksheetFunction.Transpose(SourceSheet.Range("E2:E" & SourceLastRow).Value)
                    
          
                    Dim Foreign_Field_1 As Variant
                  ReDim Foreign_Field_1(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
                                        LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
                 
                    Dim Foreign_Field_2 As Variant
                  ReDim Foreign_Field_2(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
                                        LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
                                        
                    Dim Foreign_Field_3 As Variant
                  ReDim Foreign_Field_3(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
                                        LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))

                    Dim Foreign_Field_4 As Variant
                  ReDim Foreign_Field_4(LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1), _
                                        LBound(Foreign_Key, 2) To UBound(Foreign_Key, 2))
                                        
                                        
                                        
                    ' / Write (Keys-IndexMatch) in Array offset Foreign_Field_1
                    
                    Dim i As Long
                    
                    For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
                    
                    
                    Foreign_Field_1(i, 1) = Primary_Field_1( _
                    WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
                    
                    Foreign_Field_2(i, 1) = Primary_Field_2( _
                    WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))

                    Foreign_Field_3(i, 1) = Primary_Field_3( _
                    WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
                    
                    Foreign_Field_4(i, 1) = Primary_Field_4( _
                    WorksheetFunction.Match(Foreign_Key(i, 1), Primary_Key, 0))
                    
                    Next i
    
    
                ' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
                    
                    ThisWorkbook.Worksheets("Sheet2").Range("H2:H" & TargetLastRow).Value = Foreign_Field_1
                    
                    ThisWorkbook.Worksheets("Sheet2").Range("i2:i" & TargetLastRow).Value = Foreign_Field_2
    
                    ThisWorkbook.Worksheets("Sheet2").Range("J2:J" & TargetLastRow).Value = Foreign_Field_3
    
                    ThisWorkbook.Worksheets("Sheet2").Range("K2:K" & TargetLastRow).Value = Foreign_Field_3
    
    End Sub

Upvotes: 1

Views: 92

Answers (1)

Tim Williams
Tim Williams

Reputation: 166835

Untested but try something like this:

Sub Get_Data_BYN()

    Const NUM_DATA_COLS As Long = 4
    
    Dim SourceSheet As Worksheet, TargetSheet As Worksheet
    Dim rngPrimary_Key As Range '[SourceSheet Array Store]: LAVA ID
    Dim Foreign_Key As Variant '[TargetSheet Range Store]: LAVA ID
    Dim SourceLastRow As Long, TargetLastRow As Long
    Dim Primary_Fields(1 To NUM_DATA_COLS), Foreign_Fields(1 To NUM_DATA_COLS), n As Long
    Dim i As Long, v, m
    
    Set SourceSheet = GetWorkbook(Source).Worksheets("Data")
    Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
    
    SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
    TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    'match is much faster against a range on a sheet than against an array
    Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow)
    Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value
    
    For n = 1 To NUM_DATA_COLS
        Primary_Fields(n) = SourceSheet.Range("B2:B" & SourceLastRow).Offset(0, n - 1).Value
        Foreign_Fields(n) = EmptyCopy(Foreign_Key) 'empty array for results
    Next n
    
    ' get matching rows and copy values to arrays
    For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
        v = Foreign_Key(i, 1)
        m = Application.Match(v, rngPrimary_Key, 0)
        If Not IsError(m) Then            'check got a match
            For n = 1 To NUM_DATA_COLS
                Foreign_Fields(n)(i, 1) = Primary_Fields(n)(m, 1)
            Next n
        End If
    Next i
    
    ' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
    Place2DArray TargetSheet.Range("H2"), Foreign_Fields(1)
    Place2DArray TargetSheet.Range("i2"), Foreign_Fields(2)
    Place2DArray TargetSheet.Range("J2"), Foreign_Fields(3)
    Place2DArray TargetSheet.Range("K2"), Foreign_Fields(4)
    
End Sub

'return an empty array of same dimensions as 'arr'
Function EmptyCopy(arr)
    Dim rv
    ReDim rv(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2))
    EmptyCopy = rv
End Function

'copy a 1-based 2-d array 'arr' to a worksheet, starting at cell 'c'
Sub Place2DArray(c As Range, arr)
    c.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Unless you have a lot of data though, this would be much simpler as a vlookup in a loop. Arrays are sometimes faster, but there's a lot to be said for simplicity too.

Upvotes: 3

Related Questions