Macro issues - trying to get an array to a column

  • Thread starter Thread starter valkyrie
  • Start date Start date
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
 
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
 
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
 
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
 
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
 
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
 
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
 
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
 
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---
 
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
 
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
 
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
 
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
 
Back
Top