Multidimensional Array to Single Column Range

Hi. No one but you knows what should be the result. Show in the file what needs to be done with an array.

For each loop in 2d array goes downwards first...

Sub test()
    Dim Arr, e, n As Long
    Arr=Range ("F21:L72")
    For Each e In Arr
        n = n + 1: Cells(n, 50) = e
    Next
End Sub

Hi,
or alternative
https://excelxor.com/2014/08/13/sing...-1-rows-first/

So here is another solution to add to the collection

But First.......
_1)

As kalbasiatka said No one but you knows what should be the result. It is always best to demonstrate to us ( preferably with reduced size, desensitised data ) exactly what You want

Both Akuini’s and jindon codes work for me.
Jindon’s goes ( strangely ? ) through all rows first, then columns. ( I thought VBA and Excel always went from right to left then top to bottom? Maybe a Arr is different)

Akuini’s is made to go through each column before going down a row.

I do not feel like doing Pike’s solution way just now, ( although at first glance it does seem to be explained very well ), but I would like to see it applied to your application as another interesting solution, How about it Pike ?

My Guess was that you wanted rows then columns, as you have confirmed now. My Code does that.
Note All codes just give you Values Out

To demo first on reduced data for our three codes.

Say this is your Data

Using Excel 2007

Row\Col	F	G	H
21	f21	g21	h21
22	f22	g22	h22
23	f23	g23	h23

pgcArraysSplitToColumn

_.....

then using a version of code from Akuini

Sub Akuini()
Columns(50).ClearContents
Dim Arr() As Variant
Arr = Range("F21: H24")
Dim i As Long, j As Long, k As Long
For i = 1 To UBound(Arr)
    For j = 1 To 7
        k = k + 1
        Cells(k, 50).Value = Arr(i, j)
    Next j
Next i
End Sub

You get this:

Using Excel 2007

Row\Col	AX
1	f21
2	g21
3	h21
4	f22
5	g22
6	h22
7	f23
8	g23
9	h23

pgcArraysSplitToColumn

_...............................................
Or
using a version of code from jindon

Sub jindon()
Columns(50).ClearContents
    Dim Arr, e, n As Long
    Arr = Range("F21:H23")
    For Each e In Arr
        n = n + 1: Cells(n, 50) = e
    Next
End Sub

You get

Using Excel 2007

Row\Col	AX
1	f21
2	f22
3	f23
4	g21
5	g22
6	g23
7	h21
8	h22
9	h23

pgcArraysSplitToColumn

_...........................................
_... OK back to mother code alternative.

_....
_2 ) Here is my equivalent code ( to Akuini’s) . It gives the same results as Akuini’s
Here for the reduced input Range
Main Code for reduced Data

Sub AlanSHimpfGlified()
Dim rngIn As Range: Set rngIn = Range("F21:H23")
Range("AX1").Resize((rngIn.Rows.Count * rngIn.Columns.Count), 1).Value = Application.Transpose(Application.Index(Cells, Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & rngIn.Columns.Count & "-1))/" & rngIn.Columns.Count & "))+(" & rngIn.Row & "-1))"), Evaluate("if(column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & rngIn.Column & ")")))
End Sub

Here the code for what we guessed was your wanted Output Range
Main Code for Full input Range

Sub AlanSHimpfGlified()
Dim rngIn As Range: Set rngIn = Range("F21:L72")
Range("AX1").Resize((rngIn.Rows.Count * rngIn.Columns.Count), 1).Value = Application.Transpose(Application.Index(Cells, Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & rngIn.Columns.Count & "-1))/" & rngIn.Columns.Count & "))+(" & rngIn.Row & "-1))"), Evaluate("if(column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBASHimpfGlified(rngIn.Rows.Count * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & rngIn.Column & ")")))
End Sub

As you can see the difference is very little, but the reduced example is better to follow and understand in the Thread.
My Codes are very flexible: You just change the
Input range
and
Top Cell Range
of where the output should go.

Note: For both my codes you need also this Function. Just copy it to the same Module that your main code is in. There are simple Functions to do that BTW. Just that seemed the quickest. Many of those are explained in detail here:
http://www.excelforum.com/tips-and-t...explained.html

A Function to get Column Letter from Column Number

Public Function shgMathsVBASHimpfGlified(ByVal lclm As Long) As String '   http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html#post4221359
Let shgMathsVBASHimpfGlified = IIf(((((lclm - 1) \ 26) - 1) \ 26), Chr(65 + (((((lclm - 1) \ 26) - 1) \ 26) - 1 Mod 26)), "") & IIf(((lclm - 1) \ 26), Chr(65 + (((lclm - 1) \ 26) - 1) Mod 26), "") & IIf(lclm, Chr(65 + (lclm - 1) Mod 26), "")
End Function

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

There you go... or almost....

Originally Posted by Jonathan78

.....I go for akuinis solution ......because I found yours harder to understand

I do not like to use codes I do not understand. Mine is very hard to understand , but if you can you would learn a lot. For the benefit of anyone interested, in the next post I explain it in full detail, ( For ease of explanation it works on the reduced size data I gave in the first screen shot above.

I do not like to use codes I do not understand. Mine is very hard to understand , but if you can you would learn a lot. For the benefit of anyone interested, in this post I explain my Code in full detail, ( For ease of explanation it works on the reduced size data I gave in the first screen shot above.

So the Explnation of Alan’s codes.
Code also here:
http://www.excelforum.com/showthread...10#post4381972

In words first briefelly.
To Fully understand , run the code in F8 debug mode, and follow through, the comments and what happens in the Worksheet. Also if you know how set watches on variables ( Highlight variable in code anywhere and hit SHIFT + F9 ), do that and see how they are filled

In Words.

The basic idea is to simply use the .Index Function in this form, ( “pseudo code” )

Output = .Index( Cells , rws(), clms() )

Cells is the entire spreadsheet Range

rws() and clms() are Arrays containing the spreadsheet row and column number you want starting from the first.

VBA .Index works in such a form such that it pairs sequentially each row and column number , then gives out the Value at those Spreadsheet co ordinates. This value it adds to the end of an ever increasing internally generated 1 D Array
VBA has a convention to allow you to paste this “long” Array of values to a Row.
But you do not want that. So we simply .Transpose that to give you a “deep” column
( I would add something in passing here. The .Transpose can be a bit quirky when transposing Values. So you might want to replace it with a simple Function. Such as here
http://www.excelforum.com/showthread...t=#post4378086
Note as you are giving a 1 D Array you will need to use the biggest code:
http://www.excelforum.com/showthread...t=#post4378089
_....)

Rem Ref pgc http://www.mrexcel.com/forum/excel-q...-column-2.html
Rem Ref shg http://www.excelforum.com/tips-and-t...ml#post4214733
_...........

So here the code , have fun in going through !!

Alan

Sub Alanpgc()    '    http://www.excelforum.com/excel-programming-vba-macros/1138428-multidimensional-array-to-single-column-range.html
' Worksheets info.
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("pgcArraysSplitToColumn")
Set ws = Worksheets("pgcArraysSplitToColumn") 'CHANGE TO SUIT YOUR SHEET
ws.Columns(50).ClearContents ' Remove any data already there, Just to be sure the next lines do any thing
Dim rngIn As Range, rngOut As Range
Set rngIn = ws.Range("F21:H23")
Set rngOut = ws.Range("AX1:AX9")
' Hard copied Indicies for rngIn in required series output.
Dim rws() As Variant, clms() As Variant 'Variant Elements chosen for these Arrays to match type of Elements returned by the mehtods we use below
Let rws() = Array(1, 1, 1, 2, 2, 2, 3, 3, 3)
Let clms() = Array(1, 2, 3, 1, 2, 3, 1, 2, 3)
' Some maths to get a more flexible solution
    '    Let rws() = Evaluate("int((column(A:I)+(3-1))/3))") ' The Maths is sound here, but you will only get the first value out of an internally made Array
    '    Let clms() = Evaluate("mod((column(A:I)-1),3))+1") ' You need to do a trick which stretches VBA to give out in your "Area" which would enclose all the values VBA has to offer           http://www.mrexcel.com/forum/excel-questions/806702-visual-basic-applications-evaluate-range-vlookup.html?#post3944034
Let rws() = Evaluate("if(column(A:I),int((column(A:I)+(3-1))/3))") ' if(column(A:I),_______) is one.....
Let clms() = Evaluate("If(column(A:I),(mod((column(A:I)-1),3))+1)") '..... Trick to return an Array of all VBA has to offer for us in this case

' We Get a 1 D Range ( "Horizontal ) using .Index which will "paired" each consequtive indicie for "row" , "column" arguments which are Arrays of indicies, and give out consequtively in an "internal" 1 D Array
Dim rng1D As Range: Set rng1D = Range("AX1:BF1")
rng1D.ClearContents ' Remove any data already there, Just to be sure the next lines do any thing
Let rng1D.Value = Application.Index(rngIn, rws(), clms()) 'Returns a 1 D range, like a special 1 D Array ( Note just values here ) ...    http://www.excelforum.com/showthread.php?t=1105617&page=2&p=4380627&highlight=#post4380627

'  We want transpose of our 1 D  " horizontal" "row"
Let rngOut.Value = Application.Transpose(rng1D)

'   To make more flexible we rewite to work on Cells as the Input range, and deternmine our Columns a bit easier.  ( And miss out the 1 D range bit )
'New indicies for Cells as Input Range
Let rws() = Array(21, 21, 21, 22, 22, 22, 23, 23, 23)
Let clms() = Array(6, 7, 8, 6, 7, 8, 6, 7, 8)
        '    Dim vTemp() As Variant: Let vTemp() = Application.Index(Cells, rws(), clms()): Let rngOut.Value = Application.Transpose(vTemp)
        rng1D.ClearContents: rngOut.ClearContents ' Remove any data already there, Just to be sure the next lines do any thing
Let rngOut.Value = Application.Transpose(Application.Index(ws.Cells, rws(), clms())) 'This hard copied version works so...
'...Try to make it more flexible
Dim TLrw As Long, TLclm As Long, lrws As Long, lclms As Long ' Input range Top Left rows an columns and count of rows and columns         Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in.  ( 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 TLrw = rngIn.Row: Let TLclm = rngIn.Column:  Let lclms = rngIn.Columns.Count: Let lrws = rngIn.Rows.Count
Dim CntCells As Long: CntCells = lrws * lclms ' Number of cells
Let rws() = Evaluate("if(column(A:I),int((column(A:I)+(3-1))/3))") 'Original based on Range to be used as first argument in Index
Let rws() = Evaluate("if(column(A:I),(int((column(A:I)+(3-1))/3))+(21-1))")
Let rws() = Evaluate("if(column(A:I),(int((column(A:I)+(3-1))/3))+(" & TLrw & "-1))")
Let rws() = Evaluate("if(column(A:I),(int((column(A:I)+(" & lclms & "-1))/" & lclms & "))+(" & TLrw & "-1))")
Let rws() = Evaluate("if(column(A:I),(int((column(A:I)+(" & lclms & "-1))/" & lclms & "))+(" & TLrw & "-1))")
 Dim requiredColumnLetter As String: Let requiredColumnLetter = shgMathsVBA(CntCells)
 Let requiredColumnLetter = shgMathsVBA(lrws * lclms)
 Let requiredColumnLetter = shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count)
 Let rws() = Evaluate("if(column(A:" & requiredColumnLetter & "),(int((column(A:" & requiredColumnLetter & ")+(" & lclms & "-1))/" & lclms & "))+(" & TLrw & "-1))")
 Let rws() = Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & lclms & "-1))/" & lclms & "))+(" & TLrw & "-1))")
Let rws() = Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & rngIn.Columns.Count & "-1))/" & rngIn.Columns.Count & "))+(" & TLrw & "-1))")
Let rws() = Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & rngIn.Columns.Count & "-1))/" & rngIn.Columns.Count & "))+(" & rngIn.Row & "-1))")

Let clms() = Evaluate("If(column(A:I),(mod((column(A:I)-1),3))+1)") 'Original based on Range to be used as first argument in Index
Let clms() = Evaluate("if(column(A:I),mod(column(A:I)-1,3)+1+(6-1))")
Let clms() = Evaluate("if(column(A:I),mod(column(A:I)-1,3)+1+(" & TLclm & "-1))")
Let clms() = Evaluate("if(column(A:I),mod(column(A:I)-1,3)+" & TLclm & ")")
    '    Dim requiredColumnLetter As String: Let requiredColumnLetter = shgMathsVBA(CntCells)
Let clms() = Evaluate("if(column(A:" & requiredColumnLetter & "),mod(column(A:" & requiredColumnLetter & ")-1,3)+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(CntCells) & "),mod(column(A:" & shgMathsVBA(CntCells) & ")-1,3)+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(CntCells) & "),mod(column(A:" & shgMathsVBA(CntCells) & ")-1," & lclms & ")+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(CntCells) & "),mod(column(A:" & shgMathsVBA(CntCells) & ")-1," & lclms & ")+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(lrws * lclms) & "),mod(column(A:" & shgMathsVBA(lrws * lclms) & ")-1," & lclms & ")+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(lrws * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBA(lrws * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & TLclm & ")")
Let clms() = Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & rngIn.Column & ")")
        rng1D.ClearContents: rngOut.ClearContents ' Remove any data already there, Just to be sure the next lines do any thing
Let rngOut.Value = Application.Transpose(Application.Index(ws.Cells, rws(), clms()))
Let rngOut.Value = Application.Transpose(Application.Index(ws.Cells, Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),(int((column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")+(" & rngIn.Columns.Count & "-1))/" & rngIn.Columns.Count & "))+(" & rngIn.Row & "-1))"), Evaluate("if(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & "),mod(column(A:" & shgMathsVBA(rngIn.Rows.Count * rngIn.Columns.Count) & ")-1," & rngIn.Columns.Count & ")+" & rngIn.Column & ")")))

End Sub
Rem Ref pgc   http://www.mrexcel.com/forum/excel-questions/908760-visual-basic-applications-copy-2-dimensional-array-into-1-dimensional-single-column-2.html
Function shgMathsVBA(ByVal lclm As Long) As String '
        '    Dim vtemp
        '    Let vtemp = IIf(((((lclm - 1) \ 26) - 1) \ 26) <> 0, Chr(65 + (((((lclm - 1) \ 26) - 1) \ 26) - 1 Mod 26)), "")
        '    Let vtemp = Evaluate("IF(QUOTIENT(QUOTIENT(" & lclm & "-1, 26)-1, 26), CHAR(MOD(QUOTIENT(QUOTIENT(" & lclm & "-1, 26)-1, 26), 26)-1 + 65), """") ")
        '    Let vtemp = IIf(((lclm - 1) \ 26) <> 0, Chr(65 + (((lclm - 1) \ 26) - 1) Mod 26), "")
        '    Let vtemp = Evaluate("IF(QUOTIENT(" & lclm & "-1, 26), CHAR(MOD(QUOTIENT(" & lclm & "-1, 26)-1, 26) + 65), """")")
        '    Let vtemp = IIf(lclm <> 0, Chr(65 + (lclm - 1) Mod 26), "")
        '    Let vtemp = Evaluate("IF(" & lclm & ", CHAR(MOD(" & lclm & "-1, 26) + 65), """") & """"")
        '    Let FucshgMathsVBA = IIf(((((lclm - 1) \ 26) - 1) \ 26) <> 0, Chr(65 + (((((lclm - 1) \ 26) - 1) \ 26) - 1 Mod 26)), "") & IIf(((lclm - 1) \ 26) <> 0, Chr(65 + (((lclm - 1) \ 26) - 1) Mod 26), "") & IIf(lclm <> 0, Chr(65 + (lclm - 1) Mod 26), "")
Let shgMathsVBA = IIf(((((lclm - 1) \ 26) - 1) \ 26), Chr(65 + (((((lclm - 1) \ 26) - 1) \ 26) - 1 Mod 26)), "") & IIf(((lclm - 1) \ 26), Chr(65 + (((lclm - 1) \ 26) - 1) Mod 26), "") & IIf(lclm, Chr(65 + (lclm - 1) Mod 26), "")
        '    Let FucshgMathsVBA = Evaluate("IF(QUOTIENT(QUOTIENT(" & lclm & "-1, 26)-1, 26), CHAR(MOD(QUOTIENT(QUOTIENT(" & lclm & "-1, 26)-1, 26)-1, 26) + 65), """") & IF(QUOTIENT(" & lclm & "-1, 26), CHAR(MOD(QUOTIENT(" & lclm & "-1, 26)-1, 26) + 65), """") & IF(" & lclm & ", CHAR(MOD(" & lclm & "-1, 26) + 65), """") & """"")
End Function
Rem Ref shg   http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html#post4214733