List sorting and rearranging

play around with

Sub testOne()
    Dim SortNoDupes As New Collection, NoDupes As New Collection, Unique As New Collection
    Dim TotalList As New Collection, Dupes As New Collection
    Dim Cell As Range, AllCells As Range
    Dim n!, p#, j!, i!, ii!, iii!, v!, iv!, iiv!, iiiv!, vi!, z(), item, y, o
    Dim Swap1$, Swap2$, Compare1$, Compare2$, ItemsTotalList$, ItemsNoDupes$, ItemsDupes$, ItemsSortNoDupes$, ItemsUniqueList$

    Set AllCells = Worksheets("Quiescent").Range("A1", Range("A65536").End(xlUp))

    For Each Cell In AllCells
        On Error Resume Next
        NoDupes.Add Cell.Value, CStr(Cell.Value)
        Unique.Add Cell.Value, CStr(Cell.Value)
        If Err.Number = 457 Then
            Dupes.Add Cell.Value    ', CStr(Cell.Value)
            On Error GoTo 0
        End If
    Next Cell
    
    For Each Cell In AllCells
        TotalList.Add Cell.Value
    Next Cell
For i = 1 To TotalList.Count - 1
        For j = i + 1 To TotalList.Count
            If TotalList(i) > TotalList(j) Then
                Swap1 = TotalList(i)
                Swap2 = TotalList(j)
                TotalList.Add Swap1, Before:=j
                TotalList.Add Swap2, Before:=i
                TotalList.Remove i + 1
                TotalList.Remove j + 1
            End If
        Next j
    Next i
    On Error Resume Next

    For Each Cell In AllCells
        SortNoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell

    On Error GoTo 0
    
    For Each o In Dupes
        For p = 1 To Unique.Count - 1
            Compare2 = o
            Compare1 = Unique.item(p)
            If Compare1 = Compare2 Then
                Unique.Remove p
            End If
        Next p
    Next o

    For i = 1 To SortNoDupes.Count - 1
        For j = i + 1 To SortNoDupes.Count
            If SortNoDupes(i) > SortNoDupes(j) Then
                Swap1 = SortNoDupes(i)
                Swap2 = SortNoDupes(j)
                SortNoDupes.Add Swap1, Before:=j
                SortNoDupes.Add Swap2, Before:=i
                SortNoDupes.Remove i + 1
                SortNoDupes.Remove j + 1
            End If
        Next j
    Next i

    For Each item In TotalList
        ItemsTotalList = ItemsTotalList & item & vbCrLf
    Next item
      MsgBox "Total List" & vbCrLf & ItemsTotalList

    For Each item In NoDupes
        ItemsNoDupes = ItemsNoDupes & item & vbCrLf
    Next item
      MsgBox "No Duplicates List" & vbCrLf & ItemsNoDupes

    For Each item In Dupes
        ItemsDupes = ItemsDupes & item & vbCrLf
    Next item
      MsgBox "Duplicates List" & vbCrLf & ItemsDupes

    For Each item In SortNoDupes
        ItemsSortNoDupes = ItemsSortNoDupes & item & vbCrLf
    Next item
      MsgBox "Sort No Duplicates List" & vbCrLf & ItemsSortNoDupes

    For Each item In Unique
        ItemsUniqueList = ItemsUniqueList & item & vbCrLf
        Debug.Print ItemsUniqueList
    Next item
    MsgBox "Unique List" & vbCrLf & ItemsUniqueList


    v = Application.WorksheetFunction.Max(TotalList.Count, NoDupes.Count, Dupes.Count, Unique.Count)
    ReDim z(1 To v, 1 To 4)
    For iv = 1 To TotalList.Count
        z(iv, 1) = TotalList(iv)
        For iiv = 1 To NoDupes.Count
            z(iiv, 2) = NoDupes(iiv)
            For iiiv = 1 To Dupes.Count
                z(iiiv, 3) = Dupes(iiiv)
                For vi = 1 To Unique.Count
                    z(vi, 4) = Unique(vi)
                Next vi
            Next iiiv
        Next iiv
    Next iv

    Cells(1, 6).Resize(, 4).Value = Array("Total List", "No Duplicates List", "Duplicates List", "Unique List")
    Cells(2, 6).Resize(UBound(z, 1), UBound(z, 2)).Value = z
End Sub

NightJumper,

if you're starting out with VBA, this is probably not the easiest challenge to begin with.

See this thread for links to VBA tutorials and resources

http://www.excelforum.com/excel-work...additions.html

You need to copy the code pike provided into a standard module in the VB Editor:

- copy the code above, but start with the line below Sub testOne()
- in Excel click Tools - Macro - Macros
- enter testOne into the macro name box
- click create
- paste the code into the window that opens

Now you can run the code via Tools - Macro - Macros