0

Target - to combine multiple 2D arrays from multiple Excel files into single 2D array. I'm first time in coding and VBA.

Sub RangeToArray()
Dim s As String, MyFiles As String
Dim i As Long, j As Long, r As Long, m As Long, n As Long
Dim dArray() As Variant, fArray() As Variant
Dim wb As Workbook, rng As Range
        
MyFiles = "path"
s = Dir(MyFiles & "*.xls")
Do While s <> ""

    ReDim fArray(ubounddArray1, ubounddArray2)
    Set wb = Workbooks.Open(MyFiles & s, False, True)
    Set rng = wb.Sheets(1).Range("A1:B2")
        dArray = rng.Value
                
        uboundfArray1 = UBound(fArray, 1)
        uboundfArray2 = UBound(fArray, 2)
        ubounddArray1 = UBound(dArray, 1)
        ubounddArray2 = UBound(dArray, 2)

        ReDim Preserve fArray(uboundfArray1, uboundfArray2 + bounddArray2 + 1)
        For m = LBound(dArray, 1) To UBound(dArray, 1)      
            For n = LBound(dArray, 2) To UBound(dArray, 2)  
                fArray(m, uboundfArray2 + n) = dArray(m, n)
            Next n
        Next m
                       
    wb.Close SaveChanges:=False
        
    s = Dir
        
Loop
    

Don't work. Write Run-time error '9': Subscript out of range.

4
  • You can't Preserve a multidimensional array that contains data. Use a bunch of separate arrays or an array of arrays or a list or a dictionary... then join the collections into a single array Commented Dec 2, 2021 at 13:05
  • Absinthe, is last dimension of array too? Commented Dec 2, 2021 at 13:12
  • You can change only the last dimension, see learn.microsoft.com/en-us/office/vba/language/reference/…. Also maybe see stackoverflow.com/questions/1588913/… or stackoverflow.com/questions/51405541/… Commented Dec 2, 2021 at 15:54
  • Absinthe, fArray(m, uboundfArray2 + n) = dArray(m, n) is write Run-time error '9': Subscript out of range. How change this code? Commented Dec 2, 2021 at 16:15

1 Answer 1

1

Untested, but this may be one way to approach it:

Sub RangeToArray()
    
    Dim s As String, MyFiles As String
    Dim fArray() As Variant, arr, i As Long
    Dim numRows As Long, numCols As Long, r As Long, c As Long, rT As Long
    Dim wb As Workbook, colArrays As Collection

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    MyFiles = "C:\Users\User\Desktop\Nezavisimai\Papka2\"
    s = Dir(MyFiles & "*.xls")
    Set colArrays = New Collection
    
    Do While s <> ""
        With Workbooks.Open(MyFiles & s, False, True)
            colArrays.Add .Sheets(1).Range("A1:B2").Value 'add array to collection
            .Close False
        End With
        s = Dir
    Loop
    
    numRows = UBound(colArrays(1), 1)
    numCols = UBound(colArrays(1), 2)  'edit:fixed typo

    ReDim fArray(1 To (numRows*colArrays.Count), 1 to numCols) 
    rT = 0
    'loop over collection and add each item to the final array
    For Each arr In colArrays
        For r = 1 To numRows
            rT = rT + 1
            For c = 1 To numCols
                fArray(rT, c) = arr(r, c)
            Next c
        Next r
    Next arr
    
    Worksheets("Insert").Range("A1") _
          .Resize(UBound(fArray, 1), UBound(fArray, 2)).Value = fArray

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

4 Comments

Tim Williams, your code is work, but your code make it: A1, B1 - 1st row, A2 B2 - 2nd row - after your code start result A1, B1, C1, D1 - 1st row. How Preserve A1,B1 - 3 row, A1,B1 - 5 row, and A2,B2- 4 row, A2, B2 - 6 row?
Can you create a screenshot of how the data should look on the final sheet?
OK I think that should be close now

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.