Page 1 of 3 123 LastLast
Results 1 to 10 of 24

Thread: Merge multiple Ranges into one Array VBA
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Merge multiple Ranges into one Array VBA



    Greetings Mr. Excel community

    This question is associated with Excel VBA code . How I can place multiple discontinuous ranges within Excel VBA array? The idea is to find an efficient method of doing , looking at what can be done without loops.

    Example:

    Rank 10 rows x 5 columns
    Rank 7 Rows x 5 columns
    Range 9 rows x 5 columns

    Place in a continuous array of 26 rows by 5 columns.

    The example is small, but must be efficient in the amount of resulting rows (about 10000+ rows ) .

    Blessings !


  2. #2
    Board Regular Kenneth Hobson's Avatar
    Join Date
    Feb 2007
    Location
    Tecumseh, OK
    Posts
    3,066
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Doing loops would likely be the fastest, otherwise:

    1. Create or use a scratch worksheet, copy the ranges, paste it, send the usedrange to your array, delete the worksheet if needed.
    or
    2. Create or use a listbox, combobox, or listview, add your items which may require a loop, send the List contents to your array, delete the control if needed.

  3. #3
    Banned user
    Join Date
    May 2014
    Location
    Germany
    Posts
    1,336
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Hi johnmpl
    If you had some specific ( reduced size ) test data I could show you in more detail along the lines of a more simplified version of what I did here.
    Excel VBA to copy and paste from horizontal to vertical format
    It is not completely without looping, but in total only looping 3 – 6 times, depending on exactly what you want to do. It would also not result in a continuous Array immediately, but something very similar.
    Basically you use a simple loop of three times to “capture the three 2 - D Arrays into a 3 element 1 Dimensional Array of those 2 – Dimensional Arrays using a one line “Range Value Capture Command” ( You can have in VBA an Array of Arrays ). Similarly you can paste out those 3 Array Elements “stacked” one on top of the other in a simple Loop of Three times, which sequentially pastes out those elements one at a time in A one line “Array Value to cells in a range command”.
    You could then of – course, re – capture in a one line Command that output Range to a single Array.
    I have had no problem doing that with Arrays of final size around 7000 columns by 40000rows
    Alan
    Last edited by DocAElstein; Nov 5th, 2015 at 05:38 PM.

  4. #4
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Thx for the response... but I now how make your suggestions... my question is if I can do it by better way than loops... Thx again.

  5. #5
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Thx DocAElstein!

    Let me check the link you post and answer about this... Blessings!

  6. #6
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Hi DocAElstein!

    This is a link for a Example in Excel. Thx for your help!

    https://mega.nz/#!lwJ0zRCJ!xyK0OSNZbLolLzH153nu4nIdSFyaGrN1cmwMbfMi8Z4

  7. #7
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    The Ranges are: A5:J39 , A44:J65 , A70:J89

    I need to put this three ranges (in real example are more) into an array. Thx!

  8. #8
    Banned user
    Join Date
    May 2014
    Location
    Germany
    Posts
    1,336
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Hi johnmpl

    I prefer to do this initially with smaller data, then everyone can see.

    So If this is your input data ( reduced size )

    Using Excel 2007
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    1
    2
    3
    VALOR TOTAL
    27188213
    4
    REGISTROS
    49
    5
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    6
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    7
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    8
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    9
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    10
    11
    12
    VALOR TOTAL
    22524031
    13
    REGISTROS
    49
    14
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    15
    1
    Nombre 14 890301884 Entidad 14
    100014
    Corriente PROVEE 12490
    421647
    42276
    16
    2
    Nombre 15 890300225 Entidad 15
    100015
    Corriente PROVEE 12489
    77200
    42276
    17
    3
    Nombre 16 860053831 Entidad 16
    100016
    Corriente PROVEE 12488
    464580
    42276
    18
    19
    20
    VALOR TOTAL
    6521022
    21
    REGISTROS
    49
    22
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    23
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    24
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    25
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    26
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    Hoja1Small

    _ .. then should this be the output ?

    Using Excel 2007
    VALOR TOTAL
    27188213
    REGISTROS
    49
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    VALOR TOTAL
    22524031
    REGISTROS
    49
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    1
    Nombre 14 890301884 Entidad 14
    100014
    Corriente PROVEE 12490
    421647
    42276
    2
    Nombre 15 890300225 Entidad 15
    100015
    Corriente PROVEE 12489
    77200
    42276
    3
    Nombre 16 860053831 Entidad 16
    100016
    Corriente PROVEE 12488
    464580
    42276
    VALOR TOTAL
    6521022
    REGISTROS
    49
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    Output

    I would initially get this entire info into a 1 Dimensional Array of three Elements. Each Element would be a 2- Dimensional Array as indicated by the different colours.

    Where should this Array be paste out? As I Mentioned this Array itself would not be a single 2 Dimensional Array. It would be a 1 Dimensional Array of three Elements. Each of those Elements would be a 2- Dimensional Array – three such Arrays in total. If you want that in a single 2 Dimensional Array, then it must be pasted out, possibly as Kenneth Hobson said to a Worksheet that could be scrapped after The pasted out entire range is re – captured finally to a single 2 – Dimensional Array

    Do you understand?

    Please try to clarify if what I suggest is what you wish.

    The idea from me and Kenneth Hobson is basically the same. It is not possible to directly produce the Array without looping, ( which as Kenneth Hobson said can be very fast internally with VBA ). Initially the ranges are pasted out, one on top of the other in a spare sheet, then re – captured into a Single Array.

    Alan

  9. #9
    Banned user
    Join Date
    May 2014
    Location
    Germany
    Posts
    1,336
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Hi johnmpl

    So the following code works along the lies suggested. Here briefly the sections of the code:

    _1) Some initial Workbook Data is obtained

    _ 2) It creates a Stack Array which is a 1 D array of Elements which are in turn 2 D Arrays corresponding to each range ( 3 in your example, but the code will do it for any number with any size ( within reason ) )

    _ 3) The Elements of the 1 D Array are then pasted out to a newly created temporary sheet, “Temp” whereby each 2 D Array element is stacked one on top of the other ( which looks like the Colourful table from my post #8 )

    _ 4 ) This Array is then captured back to an Array.

    _ 5) Message boxes demonstrate the contents of these Arrays

    Note this code will also work if your Ranges are staggered, such as this


    Using Excel 2007
    -
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    1
    2
    3
    VALOR TOTAL
    27188213
    4
    REGISTROS
    49
    5
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    6
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    7
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    8
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    9
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    10
    11
    12
    VALOR TOTAL
    22524031
    13
    REGISTROS
    49
    14
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    15
    1
    Nombre 14 890301884 Entidad 14
    100014
    Corriente PROVEE 12490
    421647
    42276
    16
    2
    Nombre 15 890300225 Entidad 15
    100015
    Corriente PROVEE 12489
    77200
    42276
    17
    3
    Nombre 16 860053831 Entidad 16
    100016
    Corriente PROVEE 12488
    464580
    42276
    18
    19
    20
    VALOR TOTAL
    6521022
    21
    REGISTROS
    49
    22
    N. NOMBRE BENEFICIARIO NIT ENTIDAD CUENTA TIPO CTA CONCEPTO REFERENCIA VALOR FECHA
    23
    1
    Nombre 1 900614115 Entidad 1
    100001
    Ahorros PROVEE 12554
    171293
    42276
    24
    2
    Nombre 2 900644770 Entidad 2
    100002
    Ahorros PROVEE 12546
    99760
    42276
    25
    3
    Nombre 3 900216067 Entidad 3
    100003
    Corriente PROVEE 12545
    919741
    42276
    26
    4
    Nombre 4 800201526 Entidad 4
    100004
    Ahorros PROVEE 12540
    99502
    42276
    Hoja1SmallTestie


    _ Here the code:

    Code:
    Option Explicit
    Sub johnmplBigStack()
    Rem 1) 'Worksheets info, Input Data
    Dim WB As Workbook: Set WB = ThisWorkbook ' 'Variable gets all methods, Properties etc. of Workbooks object, which intellisense will offer us after we use .Dot
    Dim wsData As Worksheet: Set wsData = WB.Worksheets("Hoja1SmallTestie")
    Dim srT As Long, srS As Long, sr1 As Long, srNxt As Long 'As Long 'Variable for Range start row, search start row , first start row and found next start row of Ranges. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
    Let sr1 = wsData.Cells.Find(What:="*", After:=wsData.Cells(1, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'Get next Row with entry anywhere for Worksheet Hoja1. Method: You start at first cell then go fowards , searching for anything ( = * ) by rows, then get the row number. Method that finds next row in sheet rather than next row for particular cell. Better to use that here as we are not sure which columns are full
    Let srT = sr1 ' initially start row is first start row
            '    Dim lc As Long 'Variable for last column, assuming last column is the same for all Ranges
    Dim clsr As Long 'Any column in first row of a range
            '    Let lc = wsData.Cells(sr1 + 1, Columns.Count).End(xlToLeft).Column 'The Range Object ( cell ) that is the last cell  in the row of interest has the property .End ( argument Xl to left ) appleid to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking back" the XL spreadsheet from the last cell. Then the .Column Property is applied to return a long number equal to the column number of that cell
    Rem 2) 'Make Stack Array ( 1 D array of " D Array )
    Dim arrIn() As Variant ' 'Variable for Dynamic Input Array. Will become full input data for one table Will be got with .Value Property which for a Range greater than 1 cell returns Elements of a collection which are defined initially as variant by VBA. So that is why we have Array() = Variant
    Dim StackChops() As Variant 'StackChops is an Array of Arrays. The number of Arrays in it is equal to the number of 2 D Ranges. It must continuously be resizes, so  must be Dynamic. Must be Variant type as that in the only Type that wil Take a data Field
    Dim rngNo As Long 'Number of Range/ Count of Ranges
    'Let lDB = wsData.Cells(Rows.Count, 10).End(xlUp).Row 'The Range Object ( cell ) that is the last cell  in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell
        Do While srNxt <> sr1 ' we continue until the srNxt goes past end of sheet then starts at beginning and finds initial sr1 ( as it does by the methood es use to get the next row
        Let rngNo = rngNo + 1 'Increase Range count at start of each considersation of Next Range
        Let clsr = wsData.Cells.Find(What:="*", After:=wsData.Cells(srT, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
        Let arrIn() = wsData.Cells(srT, clsr).CurrentRegion.Value2  'CurrentRegion Property applied to a Range object returns a new range which is a "box" encompasing all connected cells to that Range Object.    The Property .Value2 applied to a Range of more than 1 cell returns a colllection ( Array )  of the undelying values all the cells in that range. VBA allows a "one liner" to then assign these value to a dynamic Array. The Elements of the collection are defined initially as variant by VBA. So that is why we had Array() = Variant.
        ReDim Preserve StackChops(1 To rngNo) 'Whils preserving Array Contents, increase size to make an additional Element for next range ( By first rang this ReDims to existing size!, but WTF)
        Let StackChops(rngNo) = arrIn() 'Next Element in Array is current Input Table
        
        Let srS = srT + UBound(StackChops(rngNo), 1) 'This gives next row after current table as start for nesxt start row search.
        Let srNxt = wsData.Cells.Find(What:="*", After:=wsData.Cells(srS, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'Get next Row with entry anywhere for Worksheet Hoja1.
        Let srT = srNxt 'Set range start row to next found range start
        Loop 'While srNxt <> sr1
        
    Rem 3) ' Paste out stacks to tempory Sheet: if Shheet does not exist first make it
        If Not Evaluate("=ISREF('Temp'!A1)") Then 'Check to see if the sheet is there by seeing if the reference to cell A1 in that sheet doesn't exist. If it is true that it does not exist, then
        WB.Worksheets.Add(After:=WB.Worksheets("Hoja1SmallTestie")).Name = "Temp" 'Add  in this Workbook given name Temp
        Else
        ThisWorkbook.Worksheets("Temp").Move After:=ThisWorkbook.Worksheets("Hoja1SmallTestie") 'Otherwise If the sheet is there it could be anywhere so we put it after "Hoja1SmallTestie"
        Worksheets("Temp").Activate
        Worksheets("Temp").Cells.Clear 'Empty any previous Data. Important to use Clear, not ClearContents to remove all formatting also or else the Usedrange Property will not work below ##
        End If
    
    Dim j As Long, y As Long: Let y = 1 'Loop Bound variable Count for StackArray indicies, next rung ( row for rangge Element Top left Corner )
        For j = 1 To UBound(StackChops()) 'Going through each element in stacked " D Arrays
        Worksheets("Temp").Range("A" & y & "").Resize(UBound(StackChops(j), 1), UBound(StackChops(j), 2)).Value = StackChops(j) 'A nice "One" liner - Resize selected cell to size of output Array and then the allowed VBA assignment of a collection of values to a Spreadsheet range
        Let y = y + UBound(StackChops(j), 1) 'Increase rung to next free rung
        Next j
        
    Rem 4) ' Produce Final Output Array
    Dim arrOut() As Variant ' Dynamic Array needed as will be assigned to Tempory Sheet Usedrange, getting the Size thereof. The "One Liner Capture" method we use will return a data Field of type Variant so we must Dimension appropriately here
    Let arrOut() = Worksheets("Temp").UsedRange.Value ' ##Used range property of a Worksheet returns a Range Object that is effectivelly the "box" extending to cover all cells ever used ( changed ) in a Worksheet
    
    Rem 5) 'Demonstrate Output Array
    '5a) Stack Array
    Dim strMsgBox As String, arrLine() As Variant 'String for a Message box, 1 D Array for each row
        For j = 1 To UBound(StackChops()) 'Going through each element in stacked " D Arrays
            For y = 1 To UBound(StackChops(j), 1) 'going through each row in Stack 2 D Array Element
            Let arrLine() = Application.Index(StackChops(j), y, 0) 'Slice Array out Row to give a 1 D Array Array of that row https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/
            Let strMsgBox = strMsgBox + Join(arrLine(), ",") & vbLf 'Build String from joing 1 D Array elemnts with a "," and a carriage return
            Next y
            MsgBox Prompt:="Stack Array element " & j & " looks like this " & vbLf & strMsgBox & ""
            Let strMsgBox = "" 'Empty string for use in next Stach Element
        Next j
        Let strMsgBox = "" 'Empty string for use in next demo
    '5b) Output Array
        For y = 1 To UBound(arrOut(), 1) 'going through each row in Outpt Array
        Let arrLine() = Application.Index(arrOut(), y, 0)
        Let strMsgBox = strMsgBox + Join(arrLine(), ",") & vbLf
        Next y
    MsgBox Prompt:="Output Array looks like this " & vbLf & strMsgBox & ""
    End Sub
    
    Alan
    P.s.
    I have actually thought of a way of doing this directly with hardly any looping and without pasting out and re-capturing in using a Temporary helper sheet
    I shall possibly post that later

  10. #10
    Board Regular
    Join Date
    Jun 2013
    Posts
    233
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge multiple Ranges into one Array VBA

    Hi DocAElstein!

    Let me Check this code... I'm at Work now... Blessings and thx for all!

Some videos you may like

User Tag List

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
  •