Sorting in Wrapped Grid

Hello,

I am wondering if it's possible to sort values Left-Right AND Top-Bottom so that you wind up with a sorted grid. I have a large spreadsheet where all values need to be simultaneously in view, so we can't keep all values in a row or column, but I have not found a way to sort so that they remain in order in this grid form. I've taken a screen shot of an example of the type of sort function i'd like to preform: Unsorted grid values on the left, sorted on the right.

Sort(X&Y).jpg

Thank you for your help!

Hey shg,

That's a nifty solution! I should have mentioned- the values i'm trying to sort are Addresses- they start with numbers but contain letters, so they can't be sorted using the SMALL function, I don't think.
And even though in my example I showed a sorted grid next to an unsorted one, Ideally I'd like to just sort the existing cells without creating a fraternal twin.

Is this just not possible with excel?

Thanks,
Shane

Select the range to sort before run.

Option Explicit

Private RegX As Object

Sub test()
    Dim a, i As Long, ii As Long, x, t As Long
    Set RegX = CreateObject("VBScript.RegExp")
    With Selection
        a = .Value
        With CreateObject("System.Collections.SortedList")
            For ii = 1 To UBound(a, 2)
                For i = 1 To UBound(a, 1)
                    If a(i, ii) <> "" Then
                        x = GetSortVal(a(i, ii))
                        If Not .Contains(x) Then
                            .Item(x) = Array(1, a(i, ii))
                        Else
                            .Item(x) = Array(.Item(x)(0) + 1, .Item(x)(1))
                        End If
                    End If
                Next
            Next
            ReDim a(1 To UBound(a, 1), 1 To UBound(a, 2)): x = 1
            For i = 0 To .Count - 1
                For ii = 1 To .GetByIndex(i)(0)
                    t = t + 1
                    If t > UBound(a, 2) Then x = x + 1: t = 1
                    a(x, t) = .GetByIndex(i)(1)
                Next
            Next
        End With
        .Value = a
    End With
    Set RegX = Nothing
End Sub

Function GetSortVal(ByVal txt As String) As String
    Dim m As Object, i As Long
    With RegX
        .Global = True
        .Pattern = "\d+"
        If .test(txt) Then
            For i = .Execute(txt).Count - 1 To 0 Step -1
                Set m = .Execute(txt)(i)
                txt = Application.Replace(txt, m.firstindex + 1, _
                m.Length, Format$(m.Value, String(12, "0")))
            Next
        End If
    End With
    GetSortVal = txt
End Function