Sort column by VBA or formula

[Russk68]

Hi All

I need to sort column A first by the lowest number. Column A is always a number.Then by Column B and is always a word with many duplicates.

Example:
Sheet 1

_____A______B
1____21_____Red
2____22_____Red
3____23_____Red
4____103____Green
5____104____Green
6____105____Green
7____67_____Blue
8____13_____Blue
9____74_____Blue
10___32_____Green
11___14_____Blue
12___82_____Red
13___1______Red
14___2______Red
15___3______Red
16___55_____Blue
17___56_____Blue
18___57_____Blue

Result is just the number in column A in sheet 2:
_____A
1_____1 (Red)
2_____2 (Red)
3_____3 (Red)
4____21 (Red)
5____22 (Red)
6____23 (Red)
7____82 (Red)
8____13 (Blue)
9____14 (Blue)
10___55 (Blue)
11___56 (Blue)
12___57 (Blue)
13___67 (Blue)
14___74 (Blue)
15___32 (Green)
16__103 (Green)
17__104 (Green)
18__105 (Green)

If this is best done with a macro, I would like it to run when the sheet is calculated.
I know this can be done using Sort, but I need it to be automated.

Thank you!

Russ

 

[mumps]

This was rather tricky. Try:

Private Sub Worksheet_Calculate()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim LastRow As Long, srcWS As Worksheet, Rng As Range, RngList As Object, key As Variant, fVisRow As Long, lVisRow As Long
    Set srcWS = Sheets("Sheet1")
    Columns("B:B").Insert Shift:=xlToRight
    Columns("A").ClearContents
    With srcWS
        .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Copy Cells(3, 1)
        .Range("K1", .Range("K" & .Rows.Count).End(xlUp)).Copy Cells(3, 2)
    End With
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.ScreenUpdating = True
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add key:=Range("B3:B" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add key:=Range("A3:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A3:B" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In Range("B3", Range("B" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlLeft
    End With
    Range("A2") = "a"
    Range("B2") = "b"
    For Each key In RngList
        With Cells(2, 1).CurrentRegion
            .AutoFilter 2, key
            fVisRow = Range("B3", Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row + 1
            lVisRow = Cells(Rows.Count, "B").End(xlUp).Row
            Range("A" & fVisRow & ":B" & lVisRow).Rows.Group
        End With
        Range("A1").AutoFilter
    Next key
    Range("A2:B2").ClearContents
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add key:=Range("A3:A" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add key:=Range("B3:B" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A3:B" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlBelow
        .SummaryColumn = xlRight
    End With
    ActiveSheet.UsedRange.Rows.Ungroup
    Columns("B").Delete
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Russk68]

Hi Mumps
Does look quite complicated!
I will try this tonight and let you know how it worked out.
Thank you!

 

[Russk68]

Hi Mumps
There are a few issues that I am having. I see that this is a large favor that I am asking so I understand if you do not wish to proceed.
Thank you for your time on this!

 

[mumps]

I can't promise a solution, but I don't mind having a look at your issues. I think it would be best to upload a copy of the actual file you are working with (de-sensitized if necessary) and explain the issues using a few examples from your data. A macro may work properly with a sample file but most often will not work with the actual file.