Page 2 of 2 FirstFirst 12
Results 11 to 18 of 18

Thread: Adding entire rows to array
Thanks Thanks: 0 Likes Likes: 0

  1. #11
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,449
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Adding entire rows to array

    I haven't looked at all of your code. Maybe change the variable names to avoid confusion - something like this:
    Code:
    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.
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  2. #12
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    460
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Adding entire rows to array

    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

    Quote Originally Posted by BlakeSkate View Post

    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
    CondensedSheets
    but instead looks like

    Quote Originally Posted by BlakeSkate View Post

    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
    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?

    Code:
    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
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  3. #13
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,958
    Post Thanks / Like
    Mentioned
    467 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Adding entire rows to array

    Why not step through your code using F8 to see what is going on and why it's not giving the expected results.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  4. #14
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    460
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Adding entire rows to array

    Quote Originally Posted by Fluff View Post
    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


    Code:
                    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

    Code:
                    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
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  5. #15
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,958
    Post Thanks / Like
    Mentioned
    467 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Adding entire rows to array

    As I find it very difficult to "reverse engineer" code, especially without any data, I can't offer much more advice.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  6. #16
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    460
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Adding entire rows to array

    Quote Originally Posted by Fluff View Post
    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
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  7. #17
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    460
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Adding entire rows to array

    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.


    Code:
    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
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  8. #18
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    27,958
    Post Thanks / Like
    Mentioned
    467 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Adding entire rows to array

    Glad you sorted it out & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •