Adding entire rows to array

[DataBlake]

I'm trying to write a row to the end of an array
the logic is essentially:

i = loop through UBound of array 1
x = loop through UBound of array 2
if statement is true then

add the entire row we are looping through from array 1 to the bottom of the array
make changes to the new line and add 4 new values the columns of the row

so what i have so far looks like

Dim ary1 As Variant, ary2 As Variant
Dim ws As Worksheet, os As Worksheet
Dim i As Long, x As Long, j As Long
Dim lastRow As Long
Dim destRow As Long



Set ws = Sheets("CondensedSheets")
Set os = Sheets("Description Helper")

ary1 = ws.Range("A1").CurrentRegion.Value2
ary2 = os.Range("A13").CurrentRegion.Value2
lastRow = ws.Range("A" & Rows.count).End(xlUp).Row
destRow = lastRow + 1

For i = LBound(ary1) To UBound(ary1)
    For x = LBound(ary2) To UBound(ary2)
        If ary1(i, 2) = ary2(x, 15) Then
            If (ary1(i, 10) = ary2(x, 8) _
                Or ary1(i, 11) = ary2(x, 8)) _
                And ary1(i, 8) >= ary2(x, 2) _
                And ary1(i, 8) <= ary2(x, 3) _
                And j < 5 Then
                j = j + 1

 
        'increment row
        destRow = destRow + 1
        ReDim ary1(1 To destRow, 1 To (UBound(ary1, 2) + 4))
        
        'write the new row in the array
        [COLOR=#ff0000][B]ary1(desRow, ???) = ary1(???) [/B][/COLOR]

highlighted in red is where i'm stuck

 

[JoeMo]

I haven't looked at all of your code. Maybe change the variable names to avoid confusion - something like this:

Sub Test()
Dim Rcurr As Range, lastRow As Long, Rext As Range
Set Rcurr = ws.Range("A1").CurrentRegion
ary2 = os.Range("A13").CurrentRegion.Value2
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row  'This is the marker for where current region stops
Set Rext = Rcurr.Resize(4 * lastRow, R.Columns.Count + 4)
ary1 = Rext.Value2  'The added empty cells in Rext begin with the ary1 element ary1(lastRow +1,1)
End Sub

Note the comments as far as adding values to the ary1.

 

[DataBlake]

So i created a solution that ALMOST works perfectly using a third array
this pretty much effectively How to Create Parent-Child Data based on tables

essentially after declaring the arrays and sizing the 3rd array to be 4x longer and 5 cells wider than my data range;
i use the brand names from Description Helper in a dictionary object to determine if i'm use table 1 (columns A - G) or table 2 (columns H - N)
i loop through array 1 and reset my counters
I loop through my two tables (description Helper)

if the dictionary item exists from array 1 i'm using table 2:
- if BP 1 or BP 2 and the offset is between the min/max
- and the counter is < 5
then i tell it to loop through the columns of array 1 and write them to a new array (ary3) using p as a counter for the position (row) of the matched row
then i make changes to the old data within the new array

this is where im confused now:
then i loop through ary2 again (Description Helper) to try and match each new line with the "make"
so lets take "12348" as an example: this part number was matched 3 times
so the T U V X W of Condensed Sheets is reserved for the "short" followed by EACH "make" of each match so it should look like this

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	P#	Brand	Style	Finish	Big size	Little Size	Size	Offset	BB	BP1	BP2	Price	UPC	Weight	IMG	Title	Desc	QTY	Center
10	12348^TROA	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon	Bloonduff	Bloonduff	Bloonduff
11	12348^HCIV	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon	Bloonduff	Bloonduff	Bloonduff
12	12348^SFOR	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon	Bloonduff	Bloonduff	Bloonduff

<tbody>
</tbody>

CondensedSheets
​

but instead looks like

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	P#	Brand	Style	Finish	Big size	Little Size	Size	Offset	BB	BP1	BP2	Price	UPC	Weight	IMG	Title	Desc	QTY	Center
10	12348^TROA	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon	Bloonduff	Bloonduff	Bloonduff
11	12348^HCIV	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon
12	12348^SFOR	Gangis	Bloop	Black	39	8.5	39x8.5	30	5.93	5x120		219		37		39x8.5 Bloop Gangis Black		1	70.6	Bloon

<tbody>
</tbody>

CondensedSheets
​

so it works properly on line 10, but not 11 or 12
am i skipping part of a loop to include all 3 makes?

Sub pParent2()
    Dim Dic As Object
    Dim ary1 As Variant, ary2 As Variant, ay3 As Variant
    Dim ws As Worksheet, os As Worksheet
    Dim i As Long, x As Long, j As Long, p As Long, k As Long, n As Long, cT As Long
    Dim lastRow As Long
    Dim destRow As Long


    Set ws = Sheets("CondensedSheets")
    Set os = Sheets("Description Helper")

    ary1 = ws.Range("A1").CurrentRegion.Value2
    ary2 = os.Range("A13").CurrentRegion.Value2
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    destRow = lastRow + 1
    ReDim ary3(1 To (lastRow * 4), 1 To (UBound(ary1, 2) + 5))
    Set Dic = CreateObject("scripting.dictionary")

    'assign table id as dictionary object
    For x = LBound(ary2) To UBound(ary2)
        If Not Dic.exists(ary2(x, 15)) Then Dic.Add ary2(x, 15), ary2(x, 15)
    Next x


    For i = 2 To UBound(ary1)
        c = 0
        j = 0
        For x = LBound(ary2) To UBound(ary2)
            If Dic.exists(ary1(i, 2)) Then
            ''''''''''''''''''''''tsw table ''''''''''''''''''''''''''''''''''
                If (ary1(i, 10) = ary2(x, 8) _
                Or ary1(i, 11) = ary2(x, 8)) _
                And ary1(i, 8) >= ary2(x, 9) _
                And ary1(i, 8) <= ary2(x, 10) _
                And j < 5 Then
                    j = j + 1
                    p = p + 1
        
                For k = 1 To UBound(ary1, 2)
                    ary3(p, k) = ary1(i, k)
        
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 13)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 13)
                    End If
        
                    ary3(p, 20) = ary2(x, 12)
                Next k
            
                For n = LBound(ary2) To UBound(ary2)
                    If (ary1(i, 10) = ary2(n, 8) _
                        Or ary1(i, 11) = ary2(n, 8)) _
                        And ary1(i, 8) >= ary2(n, 9) _
                        And ary1(i, 8) <= ary2(n, 10) _
                        And c < 4 Then
                            c = c + 1
                    
                        ary3(p, 20 + c) = ary2(n, 11)
                    End If
                Next n
            End If
            ''''''''''''''''''''''tsw table ''''''''''''''''''''''''''''''''''
        Else
            ''''''''''''''''''''''reg table ''''''''''''''''''''''''''''''''''
                If (ary1(i, 10) = ary2(x, 1) _
                Or ary1(i, 11) = ary2(x, 1)) _
                And ary1(i, 8) >= ary2(x, 2) _
                And ary1(i, 8) <= ary2(x, 3) _
                And j < 5 Then
                    j = j + 1
                    p = p + 1

                For k = 1 To UBound(ary1, 2)
                    ary3(p, k) = ary1(i, k)
        
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 6)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 6)
                    End If
        
                    ary3(p, 20) = ary2(x, 5)
                Next k
            
                For n = LBound(ary2) To UBound(ary2)
                    If (ary1(i, 10) = ary2(n, 1) _
                        Or ary1(i, 11) = ary2(n, 1)) _
                        And ary1(i, 8) >= ary2(n, 2) _
                        And ary1(i, 8) <= ary2(n, 3) _
                        And c < 4 Then
                            c = c + 1
                    
                        ary3(p, 20 + c) = ary2(n, 4)
                    End If
                Next n
            End If
            ''''''''''''''''''''''reg table ''''''''''''''''''''''''''''''''''
        End If
    Next x
Next i
    
ws.Range("A" & destRow).Resize(p, UBound(ary3, 2)).Value = ary3
End Sub

 

[Fluff]

Why not step through your code using F8 to see what is going on and why it's not giving the expected results.

 

[DataBlake]

Why not step through your code using F8 to see what is going on and why it's not giving the expected results.

i am currently, and i have about 3 times now
i have 0 clue as to why it works for the first match but everyone thereafter it only posts the "short".
i thought changing

                For k = 1 To UBound(ary1, 2)
                    ary3(p, k) = ary1(i, k)
        
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 13)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 13)
                    End If
        
                    ary3(p, 20) = ary2(x, 12)
                Next k
            
                For n = LBound(ary2) To UBound(ary2)
                    If (ary1(i, 10) = ary2(n, 8) _
                        Or ary1(i, 11) = ary2(n, 8)) _
                        And ary1(i, 8) >= ary2(n, 9) _
                        And ary1(i, 8) <= ary2(n, 10) _
                        And c < 4 Then
                            c = c + 1
                    
                        ary3(p, 20 + c) = ary2(n, 11)
                    End If
                Next n

to

                For k = 1 To UBound(ary1, 2)
                    ary3(p, k) = ary1(i, k)
        
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 13)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 13)
                    End If
        
                    ary3(p, 20) = ary2(x, 12)
                
            
                For n = LBound(ary2) To UBound(ary2)
                    If (ary1(i, 10) = ary2(n, 8) _
                        Or ary1(i, 11) = ary2(n, 8)) _
                        And ary1(i, 8) >= ary2(n, 9) _
                        And ary1(i, 8) <= ary2(n, 10) _
                        And c < 4 Then
                            c = c + 1
                    
                        ary3(p, 20 + c) = ary2(n, 11)
                    End If
                Next n
               Next k

would solve my problem, but it diiiiiidn't and now i'm saaaaaaaaaaad
it will write ary3(p,20) to the array, but not the For N statement

 

[Fluff]

As I find it very difficult to "reverse engineer" code, especially without any data, I can't offer much more advice.

 

[DataBlake]

As I find it very difficult to "reverse engineer" code, especially without any data, I can't offer much more advice.

i got it!
my counter for the N loop was not being reset because i had it after my I loop
i also added a lot of "error handling" to make the code faster/easier to step through
as well there was a lot of stuff in loops that did not need to be in loops.
will post the finished code w/ comments soon

 

[DataBlake]

Here is my solution. Its rather complicated, but it worked for me.
so tl:dr
instead of adding a row to the end of an already existing array; i used a new array to add what i would have to the end of my data sheet
this code in specific is being used to generate parent-child products from a parent part number based on size, color, etc
if you can figure it out you can amend it.

Sub pParent2()
    Dim Dic As Object
    Dim ary1 As Variant, ary2 As Variant, ay3 As Variant
    Dim ws As Worksheet, os As Worksheet
    Dim i As Long, x As Long, j As Long, p As Long, k As Long, n As Long, cT As Long
    Dim lastRow As Long
    Dim destRow As Long

    'declare the sheets for data and info tables
    Set ws = Sheets("CondensedSheets")
    Set os = Sheets("Description Helper")
    
    'declare and size our arrays
    ary1 = ws.Range("A1").CurrentRegion.Value2
    ary2 = os.Range("A13").CurrentRegion.Value2
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    destRow = lastRow + 1
    ReDim ary3(1 To (lastRow * 4), 1 To (UBound(ary1, 2) + 5))
    
    'declare dictionary
    Set Dic = CreateObject("scripting.dictionary")

    'assign table id as dictionary object
    For x = LBound(ary2) To UBound(ary2)
        If Not Dic.exists(ary2(x, 15)) Then Dic.Add ary2(x, 15), ary2(x, 15)
    Next x

    'loop through data
    For i = 2 To UBound(ary1)
        j = 0
        
        'loop through info tables & find matches
        For x = 2 To UBound(ary2)
            If Dic.exists(ary1(i, 2)) Then
                ''''''''''''''''''''''tsw table ''''''''''''''''''''''''''''''''''
                'if parameters are true then look in the tsw table
                If (ary1(i, 10) = ary2(x, 8) _
                    Or ary1(i, 11) = ary2(x, 8)) _
                    And ary1(i, 8) >= ary2(x, 9) _
                    And ary1(i, 8) <= ary2(x, 10) _
                    And j < 5 Then
                        j = j + 1
                        p = p + 1
                    
                    'if a match is found loop through columns of data and write them to 3rd array
                    For k = 1 To UBound(ary1, 2)
                        ary3(p, k) = ary1(i, k)
                    Next k
                    
                    'if the item is a set of 4 exclude adding the caret symbol as its already there
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 13)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 13)
                    End If
                    
                    'add the short code from the info table to the 3rd array
                    ary3(p, 20) = ary2(x, 12)
                    
                    'add the top 4 applicable Makes to the 3rd array
                    c = 0
                    For n = LBound(ary2) To UBound(ary2)
                        'if we have reached 4 Makes go to the next line
                        If c > 3 Then GoTo Err
                        If (ary1(i, 10) = ary2(n, 8) _
                            Or ary1(i, 11) = ary2(n, 8)) _
                            And ary1(i, 8) >= ary2(n, 9) _
                            And ary1(i, 8) <= ary2(n, 10) _
                            And c < 4 Then
                                c = c + 1
                    
                            ary3(p, 20 + c) = ary2(n, 11)
                        End If
                    Next n
Err:
                'if no match go to the next line of data
                Else: GoTo Err2
                End If
                ''''''''''''''''''''''tsw table ''''''''''''''''''''''''''''''''''
            Else
                ''''''''''''''''''''''reg table ''''''''''''''''''''''''''''''''''
                'if parameters are true then look in the regular table
                If (ary1(i, 10) = ary2(x, 1) _
                    Or ary1(i, 11) = ary2(x, 1)) _
                    And ary1(i, 8) >= ary2(x, 2) _
                    And ary1(i, 8) <= ary2(x, 3) _
                    And j < 5 Then
                        j = j + 1
                        p = p + 1
                        
                    'if a match is found loop through columns of data and write them to 3rd array
                    For k = 1 To UBound(ary1, 2)
                        ary3(p, k) = ary1(i, k)
                    Next k
                    
                    'if the item is a set of 4 exclude adding the caret symbol as its already there
                    If InStr(1, ary1(i, 1), "^4", 1) > 0 Then
                        ary3(p, 1) = ary1(i, 1) & ary2(x, 6)
                    Else
                        ary3(p, 1) = ary1(i, 1) & "^" & ary2(x, 6)
                    End If
                    
                    'add the short code from the info table to the 3rd array
                    ary3(p, 20) = ary2(x, 5)
               
                    'add the top 4 applicable Makes to the 3rd array
                    c = 0
                    For n = LBound(ary2) To UBound(ary2)
                        'if we have reached 4 Makes go to the next line
                        If c > 3 Then GoTo Err3
                        If (ary1(i, 10) = ary2(n, 1) _
                            Or ary1(i, 11) = ary2(n, 1)) _
                            And ary1(i, 8) >= ary2(n, 2) _
                            And ary1(i, 8) <= ary2(n, 3) _
                            And c < 4 Then
                                c = c + 1
                    
                            ary3(p, 20 + c) = ary2(n, 4)
                        End If
                    Next n
Err3:
'if no match go to the next line of data
Else: GoTo Err2
                End If
                ''''''''''''''''''''''reg table ''''''''''''''''''''''''''''''''''
            End If
        Next x
Err2:
    Next i
    
    'write 3rd array to the data sheet
    ws.Range("A" & destRow).Resize(p, UBound(ary3, 2)).Value = ary3
End Sub

 

[Fluff]

Glad you sorted it out & thanks for the feedback