Merge multiple Ranges into one Array VBA

johnmpl

Board Regular
Joined
Jun 14, 2013
Messages
237
Office Version
  1. 365
Platform
  1. Windows


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 !

 
Here is a slightly simplified version of the last code, but it basically does the same

Rich (BB code):
'
Sub johnmplBigStackSHimpfGlified()
Rem 1)
Dim WB As Workbook: Set WB = ThisWorkbook
Dim wsData As Worksheet: Set wsData = WB.Worksheets("Hoja1SmallTestie")
Dim srT As Long, sr1 As Long
Let sr1 = wsData.Cells.Find(What:="*", After:=wsData.Cells(1, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
Rem 2)
Dim arrIn(), StackChops()
Dim rngNo As Long
    Do While srT <> sr1
    If srT = 0 Then Let srT = sr1
    Let rngNo = rngNo + 1
    Let arrIn() = wsData.Cells(srT, wsData.Cells.Find(What:="*", After:=wsData.Cells(srT, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column).CurrentRegion.Value2
    ReDim Preserve StackChops(1 To rngNo)
    Let StackChops(rngNo) = arrIn()
    Let srT = srT + UBound(StackChops(rngNo), 1)
    Let srT = wsData.Cells.Find(What:="*", After:=wsData.Cells(srT, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
    Loop
Rem 3)
    If Not Evaluate("=ISREF('Temp'!A1)") Then
    WB.Worksheets.Add(After:=WB.Worksheets("Hoja1SmallTestie")).Name = "Temp"
    Else
    ThisWorkbook.Worksheets("Temp").Move After:=ThisWorkbook.Worksheets("Hoja1SmallTestie")
    Worksheets("Temp").Activate
    Worksheets("Temp").Cells.Clear
    End If
Dim j As Long, y As Long: Let y = 1
    For j = 1 To UBound(StackChops())
    Worksheets("Temp").Range("A" & y & "").Resize(UBound(StackChops(j), 1), UBound(StackChops(j), 2)).Value = StackChops(j)
    Let y = y + UBound(StackChops(j), 1)
    Next j
Rem 4)
Dim arrOut(): Let arrOut() = Worksheets("Temp").UsedRange.Value
Rem 5)
Dim strMsgBox As String
    For j = 1 To UBound(StackChops())
        For y = 1 To UBound(StackChops(j), 1)
        Let strMsgBox = strMsgBox + Join(Application.Index(StackChops(j), y, 0), ",") & vbLf
        Next y
        MsgBox Prompt:="Stack Array element " & j & " looks like this " & vbLf & strMsgBox & ""
        Let strMsgBox = ""
    Next j
    Let strMsgBox = ""

    For y = 1 To UBound(arrOut(), 1)
    Let strMsgBox = strMsgBox + Join(Application.Index(arrOut(), y, 0), ",") & vbLf
    Next y
MsgBox Prompt:="Output Array looks like this " & vbLf & strMsgBox & ""
End Sub


I will do the ( almost ) "full" Array version for you later

Alan
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Hi Alan!

I thank you too much you've taken the time to comment me the code to understand it better . I knew exactly what he wanted to do , and thought it was great !


Now, with your permission , I edited the code a bit (for the range I needed), and I tried to 7000+ rows. It took my pc ( for the example in question ) about half a second.


I show that I generated code.

Code:
Sub johnmplBigStackSHimpfGlifiedEdited()
   Rem 0) 'Check time for do it
      Dim t As Single: t = Timer
   
   Rem 1) 'Worksheets info, Input Data
      Dim WB As Workbook: Set WB = ThisWorkbook
      Dim wsData As Worksheet: Set wsData = WB.Worksheets("Hoja1SmallTestie")
      Dim srT As Long, sr1 As Long
      Let sr1 = wsData.Cells.Find("*", wsData.Cells(1, 1), xlValues, xlPart, xlByRows, xlNext).Row
      
   Rem 2) 'Make Stack Array ( 1 D array of " D Array )
      Dim arrIn(), StackChops()
      Dim rngNo As Long
      Do While srT <> sr1
         If srT = 0 Then Let srT = sr1
         Let rngNo = rngNo + 1
         With wsData.Cells(srT, wsData.Cells.Find("*", wsData.Cells(srT, 1), xlValues, xlPart, xlByRows, xlNext).Column).CurrentRegion
            Let arrIn() = .Offset(2).Resize(.Rows.Count - 2).Value2
         End With
         ReDim Preserve StackChops(1 To rngNo)
         Let StackChops(rngNo) = arrIn()
         Let srT = srT + UBound(StackChops(rngNo), 1) + 2
         Let srT = wsData.Cells.Find("*", wsData.Cells(srT, 1), xlValues, xlPart, xlByRows, xlNext).Row
      Loop
      
  Rem 3) ' Paste out stacks to tempory Sheet: if Shheet does not exist first make it
       If Not Evaluate("=ISREF('Temp'!A1)") Then
         WB.Worksheets.Add(After:=wsData).Name = "Temp"
       Else
         ThisWorkbook.Worksheets("Temp").Move After:=wsData
         Worksheets("Temp").Activate
         Worksheets("Temp").Cells.Clear
       End If
   Dim j As Long, y As Long: Let y = 1
       For j = 1 To UBound(StackChops())
         Worksheets("Temp").Range("A" & y).Resize(UBound(StackChops(j), 1), UBound(StackChops(j), 2)).Value = StackChops(j)
         Let y = y + UBound(StackChops(j), 1)
       Next j
   
   Rem 4) ' Produce Final Output Array
      Dim arrOut(): Let arrOut() = Worksheets("Temp").UsedRange.Value
      MsgBox "Terminated in " & Format(Timer - t, "0.000 seg")
'   Rem 5) 'Demonstrate Output Array
'      Dim strMsgBox As String
'          For j = 1 To UBound(StackChops())
'              For y = 1 To UBound(StackChops(j), 1)
'              Let strMsgBox = strMsgBox + Join(Application.Index(StackChops(j), y, 0), ",") & vbLf
'              Next y
'              MsgBox Prompt:="Stack Array element " & j & " looks like this " & vbLf & strMsgBox & ""
'              Let strMsgBox = ""
'          Next j
'          Let strMsgBox = ""
'
'          For y = 1 To UBound(arrOut(), 1)
'          Let strMsgBox = strMsgBox + Join(Application.Index(arrOut(), y, 0), ",") & vbLf
'          Next y
'      MsgBox Prompt:="Output Array looks like this " & vbLf & strMsgBox & ""
End Sub

I'm still waiting for the new version. Thx again for all your help!
 
Upvote 0
Hi
.....
I thank you too much you've taken the time to comment me the code to understand it better .....!
You are welcome, and thanks for the very good feedback. - That is unusual and much appreciated :)
Alan

I will post again when I have a vew code

Alan

P.s .
Thanky for including Time results. I shall look further at that aspect
 
Upvote 0
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!
For that arrangement, try this code.
The three ranges should immediately be placed into the single array vData

Rich (BB code):
Sub RangesToArray()
  Dim vRws As Variant, vData As Variant
  
  vRws = Application.Transpose(Split( _
          Join(Application.Transpose(Evaluate("row(5:39)"))) & " " & _
          Join(Application.Transpose(Evaluate("row(44:65)"))) & " " & _
          Join(Application.Transpose(Evaluate("row(70:89)")))))
  vData = Application.Index(Cells, vRws, Application.Transpose(Evaluate("row(1:10)")))
End Sub
 
Upvote 0
If you have a lot or "row groups", rather than making a very long line like my vRws above, you could use a structure like this.

Rich (BB code):
Sub RangesToArray_v2()
  Dim vRws As Variant, vData As Variant, RowBits As Variant
  Dim i As Long
  Dim s As String
  
  Const sRowGroups As String = "5:39 44:65 70:89" '<- Add more if required (For a single row use like 91:91)
  
  RowBits = Split(sRowGroups)
  For i = 0 To UBound(RowBits)
    s = s & " " & Join(Application.Transpose(Evaluate(Replace("row(#)", "#", RowBits(i)))))
  Next i
  vRws = Application.Transpose(Split(Mid(s, 2)))
  vData = Application.Index(Cells, vRws, Application.Transpose(Evaluate("row(1:10)")))
End Sub
 
Last edited:
Upvote 0
Hi johnmpl

My “Array” code attempts. There is some looping, but it is done within VBA so should be very fast
In principle they are working similarly to those from PeterSS
There are a few important restrictions to the code compared with my earlier one in its current form:

_1 ) For this code, the Ranges may not be staggered.

_2 ) The code references column H to determine the Height ( maximum vertical extent ) of each Range.

_3 ) The Used Range Property is used initially to get at all Input Data. It is therefore essential that your Input Data sheet only ever had your Data in it. Otherwise it may “Capture” unwanted cells. Best is to make sure your data ( and only your data 9 was pasted to a fresh sheet.

_4) You may not have empty cells within column H of your Ranges

All the above restrictions can all be overcome using normal spreadsheet interaction techniques, but that will of course increase speed

_ Otherwise the code allows you to change widths of your ranges ( as long as the width is the same for all ranges ), and have any amount of ranges of any height. – ( noting restriction _2) )

There are two basic Code Types. For each, the Simplified version, then a version with explaining ‘comments

Codes1

Code:
[color=darkgreen]'[/color]
[color=blue]Sub[/color] johnmplBigArray_StringSHimpfGlified()
Rem 2) Full Data [color=blue]Input[/color]
[color=blue]Dim[/color] arrIn(): arrIn() = ThisWorkbook.Worksheets("Hoja1SmallTestie").UsedRange.Value
Rem 3) Determine Required rows in entire Data
[color=blue]Dim[/color] strrws [color=blue]As[/color] [color=blue]String[/color]
[color=blue]Dim[/color] rw [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1)
    [color=blue]If[/color] arrIn(rw, 8) <> "" [color=blue]Then[/color] strrws = strrws & " " & rw
[color=blue]Next[/color] rw
Rem 5) [color=blue]Output[/color] Array
[color=blue]Dim[/color] arrOut(): arrOut() = Application.Index(arrIn(), Application.Transpose(Split(Trim(strrws), " ")), Evaluate("column(A:" & Replace(Replace(Cells(1, [color=blue]UBound[/color](arrIn(), 2)).Address, "1", ""), "$", "") & ")"))
[color=blue]End[/color] [color=blue]Sub[/color]
[color=darkgreen]'[/color]
'
'



[color=blue]Sub[/color] johnmplBigArray_String() 'http://www.mrexcel.com/forum/excel-questions/899838-merge-multiple-ranges-into-one-array-visual-basic-applications.html?#post4334415
Rem 1) [color=darkgreen]'Worksheets info, Input Data[/color]
[color=blue]Dim[/color] WB [color=blue]As[/color] Workbook: [color=blue]Set[/color] WB = ThisWorkbook [color=darkgreen]' 'Variable gets all methods, Properties etc. of Workbooks object, which intellisense will offer us after we use .Dot[/color]
[color=blue]Dim[/color] wsData [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsData = WB.Worksheets("Hoja1SmallTestie")

Rem 2) Full Data [color=blue]Input[/color]
[color=blue]Dim[/color] arrIn() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]' '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[/color]
[color=blue]Let[/color] arrIn() = wsData.UsedRange.Value [color=darkgreen]'The UsedRange Property of a Workshest returns a Range Object, effectivelly the "box" encompasing all cells ever used. Then Allowed VBA One Liner - An Array of variants may be set to a collection of Range values. The Property .Value of the Range Object works as to return a collection of (Variants initially) of various types. So Initially must see an Array of Variant types for compatability[/color]

Rem 3) Determine Required rows in entire Data
[color=blue]Dim[/color] rws() [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'A Dynamic 1 D Array of size determined by number of rows of data. It will be filled by looping and we know the taype asigned to it[/color]
[color=blue]Dim[/color] rwsT() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]'Again a dynamic Array which will be a 2 D 1 column Array which we need for our "Magic" code line ## . It will be obtained by the .Transpose Method which returns variant values[/color]
[color=blue]Dim[/color] strrws [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'String of required row indicies[/color]
[color=blue]Dim[/color] rw [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]' "Rows" in Input data[/color]
[color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1) [color=darkgreen]'Going " down "rows" in Input Array[/color]
    [color=blue]If[/color] arrIn(rw, 8) <> "" [color=blue]Then[/color]
    [color=blue]Let[/color] strrws = strrws & " " & rw [color=darkgreen]' includes indicie of a required "row" in Array[/color]
    [color=blue]Else[/color] [color=darkgreen]'Condition of empty row, no action required. Redundant Code.[/color]
    [color=blue]End[/color] [color=blue]If[/color]
[color=blue]Let[/color] strrws = Trim(strrws) [color=darkgreen]'takes off first space[/color]
[color=blue]Next[/color] rw
[color=blue]Let[/color] rws() = VBA.Split(strrws, " ") [color=darkgreen]'The split Function returns a 1 D Array of string types, seperated by the specified second argument which is in this case the default[/color]
[color=blue]Let[/color] rwsT() = Application.Transpose(rws())

Rem 4) Indicies Array for columns
[color=blue]Dim[/color] clms() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]'We require all column indicies in this case. We obtain them through Evaluate method, which returns variant types[/color]
[color=blue]Dim[/color] clmLtr [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'Letter determined from column number' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969[/color]
[color=blue]Let[/color] clmLtr = Replace(Replace(Cells(1, [color=blue]UBound[/color](arrIn(), 2)).Address, "1", ""), "$", "") [color=darkgreen]'One of many ways to determine Column Letter from Column Number: http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969[/color]
[color=blue]Let[/color] clms() = Evaluate("column(A:" & clmLtr & ")") [color=darkgreen]'Returns 1  dimensional array of size _: to :_  In that array are the number _:   to :_[/color]

Rem 5) [color=blue]Output[/color] Array
[color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]'The Index Method below returns av Array of Variant Types[/color]
[color=blue]Let[/color] arrOut() = Application.Index(arrIn(), rwsT(), clms()) [color=darkgreen]'## The "magic" Line i think no one understands! http://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4167324[/color]
[color=blue]End[/color] [color=blue]Sub[/color]



Codes2

Code:
[color=blue]Sub[/color] johnmplBigArray_REDimSHimpfGlified()
Rem 2) Full Data [color=blue]Input[/color]
[color=blue]Dim[/color] arrIn(): arrIn() = ThisWorkbook.Worksheets("Hoja1SmallTestie").UsedRange.Value
Rem 3) Determine Required rows in entire Data
[color=blue]Dim[/color] rws() [color=blue]As[/color] [color=blue]String[/color]
[color=blue]ReDim[/color] rws(1 [color=blue]To[/color] 1)
[color=blue]Dim[/color] rwsT() [color=blue]As[/color] [color=blue]String[/color]
[color=blue]Dim[/color] rw [color=blue]As[/color] [color=blue]Long[/color]
Dim Nr [color=blue]As[/color] [color=blue]Long[/color]
    [color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1)
        [color=blue]If[/color] arrIn(rw, 8) <> "" [color=blue]Then[/color]
        Nr = Nr + 1
        [color=blue]ReDim[/color] [color=blue]Preserve[/color] rws(1 [color=blue]To[/color] Nr)
        rws(Nr) = rw
        [color=blue]Else[/color]
        [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] rw
[color=blue]Re[color=blue]Dim[/color][/color] rwsT(1 [color=blue]To[/color] [color=blue]UBound[/color](rws()), 1 [color=blue]To[/color] 1)
    [color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](rws())
    [color=blue]Let[/color] rwsT(rw, 1) = rws(rw)
    [color=blue]Next[/color] rw
Rem 5) [color=blue]Output[/color] Array
Dim arrOut(): arrOut() = Application.Index(arrIn(), rwsT(), Evaluate("column(A:" & Replace(Replace(Cells(1, [color=blue]UBound[/color](arrIn(), 2)).Address, "1", ""), "$", "") & ")"))
[color=blue]End[/color] [color=blue]Sub[/color]

[color=darkgreen]'[/color]
'
[color=blue]Sub[/color] johnmplBigArray_RE[color=blue]Dim[/color]() 'http://www.mrexcel.com/forum/excel-questions/899838-merge-multiple-ranges-into-one-array-visual-basic-applications.html?#post4334415
Rem 1) [color=darkgreen]'Worksheets info, Input Data[/color]
[color=blue]Dim[/color] WB [color=blue]As[/color] Workbook: [color=blue]Set[/color] WB = ThisWorkbook [color=darkgreen]' 'Variable gets all methods, Properties etc. of Workbooks object, which intellisense will offer us after we use .Dot[/color]
[color=blue]Dim[/color] wsData [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsData = WB.Worksheets("Hoja1SmallTestie")

Rem 2) Full Data [color=blue]Input[/color]
[color=blue]Dim[/color] arrIn() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]' '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[/color]
[color=blue]Let[/color] arrIn() = wsData.UsedRange.Value [color=darkgreen]'The UsedRange Property of a Workshest returns a Range Object, effectivelly the "box" encompasing all cells ever used. Then Allowed VBA One Liner - An Array of variants may be set to a collection of Range values. The Property .Value of the Range Object works as to return a collection of (Variants initially) of various types. So Initially must see an Array of Variant types for compatability[/color]

Rem 3) Determine Required rows in entire Data
Dim rws() [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'A Dynamic 1 D Array of size determined by number of rows of data. It will be filled by looping and we know the type asigned to it. It will be continually resized through REDim Preserve. We must use this Array initially - we actually want to increse ( Re Dim Prreserve ) "rows", But VBA only allows us to ReDim Preserve "along"[/color]
[color=blue]Re[color=blue]Dim[/color][/color] rws(1 [color=blue]To[/color] 1) [color=darkgreen]'Although tis will be resized, it must have some inititial size, or it cannot be "re-sized"[/color]
[color=blue]Dim[/color] rwsT() [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'Again a dynamic Array which will be a 2 D 1 column Array which we need for our "Magic" code line ## . It will be obtained by looping and we know the types. We will resize it to a spacic size once rws() size is determined[/color]
[color=blue]Dim[/color] rw [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]' "Rows" in Input data[/color]
Dim Nr [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]'Count for the number of row indicies we have, increased each time we add a row to Array[/color]
    [color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1) [color=darkgreen]'Going " down "rows" in Input Array[/color]
        [color=blue]If[/color] arrIn(rw, 8) <> "" [color=blue]Then[/color] [color=darkgreen]'Condition for getting "row" indicie[/color]
        [color=blue]Let[/color] Nr = Nr + 1 [color=darkgreen]'Need to increase size to accomadate new "row". ( First time around it resizes to initial size! )[/color]
        [color=blue]ReDim[/color] [color=blue]Preserve[/color] rws(1 [color=blue]To[/color] Nr)
        [color=blue]Let[/color] rws(Nr) = rw [color=darkgreen]'Put required indicie in at new element[/color]
        [color=blue]Else[/color] [color=darkgreen]'Condition of empty row, no action required. Redundant Code.[/color]
        [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] rw
Re[color=blue]Dim[/color] rwsT(1 [color=blue]To[/color] [color=blue]UBound[/color](rws()), 1 [color=blue]To[/color] 1) [color=darkgreen]'We can now give size to final required indicie Array[/color]
    [color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](rws()) [color=darkgreen]'for each elemnent in rws() Array[/color]
    [color=blue]Let[/color] rwsT(rw, 1) = rws(rw) [color=darkgreen]'The row in the ( only) column of 2 D array rwst() is given the corresponding indicie hels in rws()[/color]
    [color=blue]Next[/color] rw
    
Rem 4) Indicies Array for columns
[color=blue]Dim[/color] clms() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]'We require all column indicies in this case. We obtain them through Evaluate method, which returns variant types[/color]
[color=blue]Dim[/color] clmLtr [color=blue]As[/color] [color=blue]String[/color] [color=darkgreen]'Letter determined from column number' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969[/color]
[color=blue]Let[/color] clmLtr = Replace(Replace(Cells(1, [color=blue]UBound[/color](arrIn(), 2)).Address, "1", ""), "$", "") [color=darkgreen]'One of many ways to determine Column Letter from Column Number: http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969[/color]
[color=blue]Let[/color] clms() = Evaluate("column(A:" & clmLtr & ")") [color=darkgreen]'Returns 1  dimensional array of size _: to :_  In that array are the number _:   to :_[/color]

Rem 5) [color=blue]Output[/color] Array
Dim arrOut() [color=blue]As[/color] [color=blue]Variant[/color] [color=darkgreen]'The Index Method below returns av Array of Variant Types[/color]
[color=blue]Let[/color] arrOut() = Application.Index(arrIn(), rwsT(), clms()) [color=darkgreen]'## The "magic" Line i think no one understands! http://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4167324[/color]
[color=blue]End[/color] [color=blue]Sub[/color]

Alan
 
Upvote 0
Simply amazing solutions! I'm learning a lot here! I have to see it slowly. Great contributions here. I'm really happy for this. God Bless You!
 
Upvote 0
Hi again!

My new question is similar... How can I do a full array output with data base are in multiple worksheets?

For example... First Range in Sheet1, Second Range in Sheet2, Third Range in Sheet3... and so on.

Thx in advance for your answers.
 
Upvote 0
_1) How did you get on with our last codes?. Any comparisons with speed Tests etc.?

_.......................................

_2) Regarding.....
......
My new question is similar... How can I do a full array output with data base are in multiple worksheets?....First Range in Sheet1, Second Range in Sheet2, ........ and so on.
......


I doubt if I could do an ( almost ) full Array ( Like my code Sub johnmplBigArray_String() ) for the case of Ranges in different sheets.

_2a) So somehow you would have to do some Spreadsheet interaction to get a full single Range to then “capture” to an Array.
There would be infinite ways to do that , using for example my initial Temporary Sheet idea. Alternatively you could loop through all sheets after the first, copy the Range from each sheet and “stack” that on top of the first range, and so on.

If you have studied, understood, and got our codes working so far I think you should be able to do this.

Here is just a simple example to get you going.

I simply copied the Input sheet from my example in Post #8 to give a second identical Sheet with the name “Hoja1Small (2)”

I then wrote and ran this program: ( A modified version of my first simplified Code in Post # 16 )

Code:
[color=darkgreen]'[/color]
[color=blue]Sub[/color] johnmplBigArray_StringSHimpfGlified_2()
Rem 2) Full Data [color=blue]Input[/color]
[color=blue]Dim[/color] Rng1 [color=blue]As[/color] Range, Rng2 [color=blue]As[/color] Range
[color=blue]Set[/color] Rng1 = ThisWorkbook.Worksheets("Hoja1Small").UsedRange
[color=blue]Dim[/color] lr1 [color=blue]As[/color] [color=blue]Long[/color] [color=darkgreen]'Last row in UsedRange in "Hoja1Small"[/color]
[color=blue]Let[/color] lr1 = ((Rng1.Row - 1) + Rng1.Rows.Count) + 1 [color=darkgreen]'Next Free row in "Hoja1Small"[/color]
[color=blue]Set[/color] Rng2 = ThisWorkbook.Worksheets("Hoja1Small (2)").UsedRange
Rng2.Copy [color=darkgreen]'Copy Used Range in "Hoja1Small (2)" to clipboard[/color]
ThisWorkbook.Worksheets("Hoja1Small").Cells(lr1, Rng1.Column).PasteSpecial Paste:=xlPasteValues [color=darkgreen]'Paste Special Method[/color]
ThisWorkbook.Worksheets("Hoja1Small").Paste Destination:=ThisWorkbook.Worksheets("Hoja1Small").Cells(lr1, Rng1.Column) [color=darkgreen]'Paste Methogd equvalent[/color]

[color=blue]Dim[/color] NewRng [color=blue]As[/color] Range: [color=blue]Set[/color] NewRng = ThisWorkbook.Worksheets("Hoja1Small").UsedRange [color=darkgreen]'NewRange is the Range from "Hoja1Small" with range from "Hoja1Small (2)" stacked on the Top[/color]
[color=blue]Dim[/color] arrIn() [color=darkgreen]': arrIn() = ThisWorkbook.Worksheets("Hoja1Small").UsedRange.Value[/color]
arrIn() = NewRng.Value

Rem 3) Determine Required rows in entire Data
[color=blue]Dim[/color] strrws [color=blue]As[/color] [color=blue]String[/color]
[color=blue]Dim[/color] rw [color=blue]As[/color] [color=blue]Long[/color]
[color=blue]For[/color] rw = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1)
    [color=blue]If[/color] arrIn(rw, 8) <> "" [color=blue]Then[/color] strrws = strrws & " " & rw
[color=blue]Next[/color] rw
Rem 5) [color=blue]Output[/color] Array
[color=blue]Dim[/color] arrOut(): arrOut() = Application.Index(arrIn(), Application.Transpose(Split(Trim$(strrws), " ")), Evaluate("column(A:" & Replace(Replace(Cells(1, [color=blue]UBound[/color](arrIn(), 2)).Address, "1", ""), "$", "") & ")"))
[color=blue]End[/color] [color=blue]Sub[/color]



If you get this code working you see it produces an output Array which has twice as many rows as that you achieved for the original unmodified version of this code. (Sub johnmplBigArray_StringSHimpfGlified() )

The code has similar restrictions regarding Ranges having the same number of columns. ( All Ranges in each sheet could be offset from those in other sheets )

Of course, for many sheets, it would be more efficient for the code to loop through each sheet starting at the second sheet and repeating the steps in the above code.

I think you should be able to have a go at that once you have all the codes that we have done so far for you up and running

Alan

P.s. I am away now for a while, and will not be able to help further for a couple of weeks.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,927
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top