Re-arranging an matrix of numbers to a numeric list If I have an array of numbers like this:

1  3  4  6  7
1  2
2  4  5  9
5  7
1  2  3  5  


Is there a quick way to take all of the unique numbers and arrange them into a single column, like this?

1
2
3
4
5
6
7
9


The approach I have works, but takes a very long time for large matrix:

Sub Test1
Call RecordArrange
Call RemoveDuplicates2
End Sub

Private Sub RecordArrange()
Worksheets("List").Activate
Dim Rng As Range
Dim i As Long
i = 1
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim lastRow As Long
lastRow = Range("A1").End(xlDown).row

While i &lt;= lastRow

Set Rng = Range("A" &amp; i)

If IsEmpty(Rng.Offset(0, 1).Value) = False Then
Rng.Offset(0, 1).Copy
Rng.Offset(1, 0).Insert Shift:=xlDown
Rng.Offset(0, 1).Delete Shift:=xlToLeft

Else: i = i + 1

End If
Wend
Columns("A:A").Select
    ActiveWorkbook.Worksheets("List").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("List").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("List").Sort
        .SetRange Range("A1:A8000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

Private Sub RemoveDuplicates2()

Dim Rng As Range
Dim i As Long
i = 1
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim lastRow As Long
lastRow = Range("A1").End(xlDown).row

While i &lt;= lastRow
Set Rng = Range("A" &amp; i)

If Rng = Rng.Offset(1, 0) And IsEmpty(Rng.Value) = False Then
Rng.Delete Shift:=xlUp

ElseIf Rng &lt;&gt; Rng.Offset(1, 0) And IsEmpty(Rng.Value) = False Then
i = i + 1
ElseIf Application.WorksheetFunction.CountA(Rng) = 0 Then
i = i + 1
Else: i = i + 1

End If

Wend
    Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub


This does work, but it seems like a very roundabout approach. Is there a better way?
I started writing this before the other answer was posted - it's a good answer.

I would also use a dictionary because dictionaries cannot have duplicate keys

Option Explicit

Private Sub MatrixToColumn()

    Dim myMatrix As Range
    Set myMatrix = Range("A1:E5")
    Dim myDictionary As Object
    Set myDictionary = CreateObject("Scripting.Dictionary")
    Dim myCell As Range
    Dim rowNumber As Long
    rowNumber = 1
    Dim Key As Variant

    For Each myCell In myMatrix
        If Not IsEmpty(myCell) Then myDictionary(myCell.Value) = 1
    Next

    If myDictionary.Count &gt; 1 Then
       For Each Key In myDictionary.keys
            Cells(rowNumber, 10) = Key
            rowNumber = rowNumber + 1
       Next
    End If
End Sub




Now, to review your code.


Indenting, none of your code is indented. It's good practice to indent all of your code that way Labels will stick out as obvious.
Sub Test1 - I know you're just testing, but that's a very bad name for a sub. 
Call - You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument
Worksheets("List").Activate - Be sure to avoid things like .Activate - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros .
lastRow = Range("A1").End(xlDown).Row this isn't a great way to do this, the standard way is lastRow = Cells(Rows.Count, 1).End(xlUp).Row - see this answer on SO by a very talented excel MVP
Everything you're doing on the sheet can be done in the code, in a dictionary or at least in an array. That increases speed by a significant amount
Dim Rng - it's a bad name and it doesn't follow Standard VBA naming conventions which hascamelCase for local variables and PascalCase for other variables and names.
Variable names - give your variables meaningful names. Instead of Rng you could make it myMatrix or something similar.




For future reference:

If Rng = Rng.Offset(1, 0) And IsEmpty(Rng.Value) = False Then
Rng.Delete Shift:=xlUp

ElseIf Rng &lt;&gt; Rng.Offset(1, 0) And IsEmpty(Rng.Value) = False Then
i = i + 1
ElseIf Application.WorksheetFunction.CountA(Rng) = 0 Then
i = i + 1
Else: i = i + 1

End If


This piece of code can be optimized

If Not IsEmpty(Rng.Value) Then
    If Rng = Rng.Offset(1) Then Rng.Delete shift:=xlUp
Else: i = i + 1
End If




Your While loops aren't the preferred way in VBA; instead use a For loop-

For i = 1 to lastRow
Next




If IsEmpty(Rng.Offset(0, 1).Value) = False Then


I prefer to use a Not instead of If False because If usually checks for True

If Not IsEmpty(rng.offset(,1)) then




Instead of calculating lastRow twice, just pass it from one sub to the other

Private Sub RemoveDuplicates2(ByVal lastRow as Long)


Now you can

RemoveDuplicates2 lastRow


You could even pass your range as well

Private Sub RemoveDuplicates(ByVal lastRow as Long, ByVal myRange as Range)




This isn't great either

ActiveWorkbook.Worksheets("List")


Worksheets have a CodeName property - View Properties window (F4) and the (Name) field can be used as the worksheet name. This way you can avoid Sheets("List") and instead just use List.