Extracting unique numbers

[jeffmoseler]

Hello all. Thanks for any help!

I need to extract a list of unique records and list them in order from lowest to highest. I can't use a filter because it needs to be done on a different page than the data is in.

Sample data:
35
3
14
4

31
44
9
35

Answer:
3
4
9
14
31
35
44

I looked in the archives but I couldn't find anything. Any help would be apprectiated!

 

[agihcam]

try this;

Sub test()
Dim i As Long
Dim dic As Object, w()
Set dic = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
With Sheets("Sheet3")
    For i = 1 To 8
        If IsEmpty(.Cells(2, i)) Then
            .Cells(2, i).Value = "temp"
        End If
    Next
End With

With Sheets("Sheet2")
For i = 55 To 62
    For Each r In .Range(.Cells(1, i).Address & ":" & .Cells(Rows.Count, i).Address)
        If Not IsEmpty(r) Then
            If Not dic.exists(r.Value) Then
                ReDim w(0)
                w(0) = r.Value
                dic.Add r.Value, w(0)
                    With Sheets("Sheet3")
                        For ii = 1 To 8
                            .Cells(Rows.Count, ii).End(xlUp).Offset(1) = w(0)
                        Next
                    End With
            End If
        End If
    Next
Next
End With
With Sheets("Sheet3")
    For i = 1 To 8
        If .Cells(2, i).Value = "temp" Then .Cells(2, i).ClearContents
            .Range(.Cells(3, i).Address & ":" & .Cells(Rows.Count, i).Address).Sort Key1:=.Range(.Cells(3, i).Address), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Next
End With
Application.ScreenUpdating = True
End Sub

 

[jindon]

jeff
try

Sub test()
Dim dic as object, i as long, ii as long, a, x, result(), n as integer
Set dic = createobject("scripting.dictionary")
a = sheets("sheet2").range("bc2").currentregion.value
redim result(1 to ubound(a,2))
for i = 1 to ubound(a,2)
   for ii = 1 to ubound(a,1)
      if not isempty(a(ii,i)) then
         if not dic.exists(a(ii,i)) then
            dic.add a(ii,i), nothing
         end if
      end if
   next
   x = dic.keys : dic.removeall
   n = n + 1 : result(n) = x
next
erase a : set dic = nothing
with sheets("sheet3").range("a1")
   .currentregion.clearcontents
   for i = 1 to ubound(result)
      with .offset(,i-1).resize(ubound(result(i))
         .value = application.transpose(result(i))
         .sort key1:= .cells(1,1), order1:= xlascending, header:=xlno
      end with
   next
end with
end sub