Macro issues - trying to get an array to a column

V

valkyrie

I found a great macro I want to use to convert an array to a column. This
one takes an array like so:

1 2 3
4 5 6

and makes it

1
4
2
5
3
6

But I need

1
2
3
4
5
6

Can anyone help me edit it? I can't get it to work for the life of me.
Thanks!

Sub Matrix2Column()
Dim v As Variant
Dim nCol As Long
Dim nRow As Long
Dim rOut As Range
Dim iCol As Long

On Error Resume Next
v = Application.InputBox("Select range to copy", Type:=8).Value
If IsEmpty(v) Then Exit Sub
nRow = UBound(v, 1)
nCol = UBound(v, 2)

Set rOut = Application.InputBox("Select destination",
Type:=8).Resize(nRow, 1)
If rOut Is Nothing Then Exit Sub

For iCol = 1 To nCol
rOut.Value = WorksheetFunction.Index(v, 0, iCol)
Set rOut = rOut.Offset(nRow)
Next iCol
End Sub
 
V

valkyrie

Sorry for the double-post, didn't think the first one took.

Thanks for any help.
 
D

Dennis Tucker

So you have a 2 dimensional array with unsorted values. You want it
converted to a 1 dimensional array that is sorted into ascending order.

I would probably dump the 2 dimensional array, element by element, into a
open column in Excel. Then use the sort ascending function on the column.
The create a 1 dimensional array and fill it with the sorted column.

Dennis
 
V

valkyrie

Not really. The numbers were only meant to indicate the order I want them
in. The script I showed gives me stacked columns (col 1, then col 2, then
col 3). I want to have the rows stacked (row 1, row 2, then row 3).

I like this script, and I would imagine it's not a terribly complex edit to
get it to do what I want, but I can't get it edited correctly.

Thanks for any advice.

- V
 
J

Jacob Skaria

Try the below and feedback...Additional codes added to top and bottom of the
For loop..

Dim rTemp As Range
Set rTemp = rOut

'For iCol = 1 To nCol
'rOut.Value = WorksheetFunction.Index(v, 0, iCol)
'Set rOut = rOut.Offset(nRow)
'Next iCol

Range(Cells(rTemp.Row, rTemp.Column), _
Cells(rOut.Row, rOut.Column)).Sort _
Key1:=Cells(rTemp.Row, rTemp.Column), _
Order1:=xlAscending, Orientation:=xlTopToBottom

If this post helps click Yes
 
V

valkyrie

Thank you, but that didn't seem to change anything, oddly enough.

Shouldn't there be away to change the FOR loop to read rows instead of
columns? I experimented with changing the FOR loop to index by iRow instead
of iCol, but I couldn't ever get it to work.

Thanks
 
J

Jacob Skaria

May be I have not explained well enough.

You need to keep the FOR loop... I commented it just to let you know the new
codes added....

If this post helps click Yes
 
V

valkyrie

Ah-ha. Sorry, I must have put something in the wrong place. I tried again,
and it does indeed seem to be working.

Thank you! You made a rather rotten few hours sitting here at the computer
a little less painful. :) All my best.

- V
 
R

Rick Rothstein

Give this macro a try...

Sub MatrixToColumn()
Dim X As Long, M As Range, Start As Range
With Application
Set M = .InputBox("Select range to copy", Type:=8)
If M Is Nothing Then Exit Sub
Set Start = .InputBox("Select destination start cell", Type:=8)(1)
If Start Is Nothing Then Exit Sub
For X = 1 To M.Rows.Count
Start.Offset((X - 1) * M.Columns.Count).Resize(M.Columns.Count) = _
.WorksheetFunction.Transpose(M.Offset(X - 1).Rows(1))
Next
End With
End Sub
 
R

ryguy7272

This outta do it...

Sub Transpose()
Dim rng1 As Range, rng2 As Range, i As Long
On Error Resume Next
Set rng1 = Application.InputBox("Select cells to copy using mouse", Type:=8)
On Error GoTo 0
If rng1 Is Nothing Then
MsgBox "You selected nothing"
Exit Sub
End If

On Error Resume Next
Set rng2 = Application.InputBox("Select top cell to paste to using mouse ",
Type:=8)
On Error GoTo 0
If rng2 Is Nothing Then
MsgBox "You selected nothing"
Exit Sub
End If

i = 1
For Each cell In rng1
rng2(i).Formula = cell.Formula
i = i + 1
Next

End Sub

HTH,
Ryan---
 
R

Rick Rothstein

Sorry, I posted the wrong macro; this is the finalized version I meant to
post...

Sub MatrixToColumn()
Dim X As Long, M As Range, Start As Range
With Application
On Error GoTo Whoops
Set M = .InputBox("Select range to copy", Type:=8)
Set Start = .InputBox("Select destination start cell", Type:=8)(1)
For X = 1 To M.Rows.Count
Start.Offset((X - 1) * M.Columns.Count).Resize(M.Columns.Count) = _
.WorksheetFunction.Transpose(M.Offset(X - 1).Rows(1))
Next
End With
Whoops:
End Sub
 
R

Robert McCurdy

Try this Val,

Sub aMatrix2Column()
Dim v As Range, x, i As Long, c As Range
On Error Resume Next
Set v = Application.InputBox("Select range to copy", Type:=8)
On Error GoTo 0

If v Is Nothing Then
MsgBox "You have not selected a range." & vbCr & _
"Closing now!", vbExclamation
Exit Sub
End If

i = 0
ReDim x(0 To v.Count - 1)
For Each c In v.Cells
x(i) = c.Value
i = i + 1
Next c

'u can use your inputbox for the output range here
Range("H1").Resize(v.Count, 1).Value2 = _
Application.Transpose(x)
End Sub


Regards
Robert McCurdy
 
P

Patrick Molloy

add this

With rOut.Offset(-nRow * nCol).Resize(nRow * nCol, 1)
.Sort .Range("A1"), xlAscending
End With

immediately before END SUB and after all the other code.

how it works: rOut will be set to the next output 'block' so the OFFSET()
takes it back to the first cell ( rows x columns) and resizes so that the
output column is now selected. Once this is done ( thats the WITH statement
taken care of) we just sort based off the first cell in the selection
 
R

r

Sub Matrix2Column()
Dim v As Range
Dim rOut As Range
Dim i As Long

On Error Resume Next
Set v = Application.InputBox("Select range to copy", Type:=8)
If TypeName(v) = "Nothing" Then Exit Sub

Set rOut = Application.InputBox("Select destination", Type:=8)
If TypeName(rOut) = "Nothing" Then Exit Sub

For i = 1 To v.Count
rOut.Offset(i) = v.Item(i)
Next i
End Sub

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top