Avoiding Overwriting for loop within a for loop vba

Question

I am pulling out values from a variable number of sheets within excel (fifth to third from last), each of which contains a variable number of "entries". E.G. "Entry 1" has values I want in columns F and H. "Entry 2" has values I want in columns K and M, etc. (These are also referred to as "quotes" in the comments for the code).

I'm using a For loop within a For loop to accomplish this. The issue I'm having is that each recursion of the "parent" for loop is over-writing the entries created in the previous recursion. My code illustrates:

    Sub ListSheets()

    ' Creating an integer that specifies the size of the arrays of column entries
    ' and thus the maximum number of quotes.
    Dim array_size As Integer


    'Defining Arrays that will be used to select quantities of different quotes 
    '(e.g. Class)
    'Region, Date and Price all have the same column entries, meaning only one array is
    'required.
    Dim Class_Cols_Array() As Integer
    Dim RDP_Cols_Array() As Integer

    'Resizing these arrays. This resize sets the maximum number of quotes per sheet to
    '1000.
    array_size = 1000
    ReDim Class_Cols_Array(1 To array_size, 1 To 1)
    ReDim RDP_Cols_Array(1 To array_size, 1 To 1)

    'Setting the first entries as the corresponding column indexes of H and F
    'respectively.
    Class_Cols_Array(1, 1) = 8
    RDP_Cols_Array(1, 1) = 6

    ' Filling both arrays with column indexes of quotes. In both cases the row number is     
    'the same for each quote and thus
    ' does not need to be specified for each entry.
    For intLoop = 2 To 1000
        Class_Cols_Array(intLoop, 1) = Class_Cols_Array(intLoop - 1, 1) + 5
        RDP_Cols_Array(intLoop, 1) = RDP_Cols_Array(intLoop - 1, 1) + 5
    Next


    'Defining an array which will contain the number of entries/quotes (as defined by
    ' the user) for each sheet/manufacturer.
    Dim Num_of_Entries() As Integer

    ' Resizing this array to match the number of manufacturers (sheets therein) within 
    'the workbook.
    ReDim Num_of_Entries(1 To Worksheets.Count - 6, 1 To 1)

    'Defining arrays that will contain will be populated with quote quantities (e.g. 
    'Class), pulled from cells.
    Dim Class_Array() As String
    Dim Region_Array() As String
    Dim Date_Array() As String
    Dim Price_Array() As String
    Dim Manufacturer_Array() As String



    'Here number of entries for each manufacturer (sheet) are pulled out, with this 
    'value being entered into the appropriate cell(B5)
    'by the user.
    Dim i As Integer
    For i = 5 To Worksheets.Count - 2
        j = i - 4
        Num_of_Entries(j, 1) = ThisWorkbook.Worksheets(i).Cells(5, 2)
    Next



    'Creating an integer that is the total number of entries (that for all sheets 
    'combined).
    Dim total_entries As Integer
    total_entries = WorksheetFunction.Sum(Num_of_Entries)

    'Setting the size of each quantity-containing array to match the total number of 
    'entries.
    ReDim Class_Array(1 To total_entries, 1 To 1)
    ReDim Region_Array(1 To total_entries, 1 To 1)
    ReDim Date_Array(1 To total_entries, 1 To 1)
    ReDim Price_Array(1 To total_entries, 1 To 1)
    ReDim Manufacturer_Array(1 To total_entries, 1 To 1)

    'Creating a variable for the numbers of entries for a specific sheet.
    Dim entries_for_sheet As Integer

    'Creating a variable for the sheet number for a specific sheet (e.g. "Acciona_Fake 
    'is the 5th sheet).
    Dim sheet_number As Integer

    'Looping over the sheets (only fifth to third from last sheets are of interest).
    For sheet_number = 5 To Worksheets.Count - 2

        'Creating an iterating value that starts at 1 in order to match sheets to their 
        'number of entries.
        j = sheet_number - 4
        entries_for_sheet = Num_of_Entries(j, 1)

        'Looping over the entries for each sheet, extracting quote quantities and adding 
        'to their respective arrays.
        For i = 1 To entries_for_sheet
            Class_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6, 
            Class_Cols_Array(i, 1))
            Region_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6, 
            RDP_Cols_Array(i, 1))
            Date_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(8, 
            RDP_Cols_Array(i, 1))
            Price_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(41, 
            RDP_Cols_Array(i, 1))
            Manufacturer_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Name
        Next
    Next



    'Exporting all arrays.
    Sheets("vba_deposit").Range("A1").Resize(UBound(Class_Array)).Value = Class_Array
    Sheets("vba_deposit").Range("B1").Resize(UBound(Region_Array)).Value = Region_Array
    Sheets("vba_deposit").Range("C1").Resize(UBound(Date_Array)).Value = Date_Array
    Sheets("vba_deposit").Range("D1").Resize(UBound(Price_Array)).Value = Price_Array
    Sheets("vba_deposit").Range("D1").Resize(UBound(Manufacturer_Array)).Value =        
    Manufacturer_Array
    End Sub

Looking at the for loop within a for loop at the bottom, I need to find a way to keep the iteration of the RHS of the equation(s). E.G. I need the i value to be the same for,

    ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))

whereas I need the i on the LHS of the equation to also increase with each run of the "parent" for loop. I.E. I need the i to be the "number of entries thus far" + i for

    ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))

I can't figure out a way to do this. Is there perhaps a way to append an array rather than assigning values to individual elements? (This sounds really simple but I've searched and not been able to find a genuine append method, only loops of assigning to elements).

Many thanks in advance.

Most of your "2-D" arrays could be 1-D, or you could replace all of them with a single 2-D array. Structured like this, it's kind of difficult to follow what you're doing. — Tim Williams
– Tim Williams, Commented Mar 31, 2014 at 17:46

Tim Williams · Accepted Answer · 2014-03-31 19:24:57Z

2

Compiled but not tested:

Sub ListSheets()

    Dim intLoop As Long, i As Long, total_entries As Long
    Dim sht As Worksheet, sheet_number As Long
    Dim entries_for_sheet As Long
    Dim classCol As Long, RDPCol As Long
    Dim entry_num As Long

    Dim Data_Array() As String

    total_entries = 0
    entry_num = 0

    For sheet_number = 5 To Worksheets.Count - 2

        Set sht = ThisWorkbook.Worksheets(sheet_number)
        entries_for_sheet = sht.Cells(5, 2).Value
        total_entries = total_entries + entries_for_sheet

        'can only use redim Preserve on the last dimension...
        ReDim Preserve Data_Array(1 To 5, 1 To total_entries)

        classCol = 8
        RDPCol = 6

        For i = 1 To entries_for_sheet
            entry_num = entry_num + 1

            Data_Array(1, entry_num) = sht.Cells(6, classCol)
            Data_Array(2, entry_num) = sht.Cells(6, RDPCol) ' 6?
            Data_Array(3, entry_num) = sht.Cells(8, RDPCol)
            Data_Array(4, entry_num) = sht.Cells(41, RDPCol)
            Data_Array(5, entry_num) = sht.Name

            classCol = classCol + 5
            RDPCol = RDPCol + 5
        Next
    Next

    Sheets("vba_deposit").Range("A1").Resize(UBound(Data_Array, 2), _
             UBound(Data_Array, 1)).Value = Application.Transpose(Data_Array)
End Sub

answered Mar 31, 2014 at 19:24

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

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

1 Comment

vbastrangledpython Over a year ago

Sorry for late reply. Perfect! A neater way to do it as well so many thanks for that.

Collectives™ on Stack Overflow

Avoiding Overwriting for loop within a for loop vba

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