Sort columns based on named range

[theta]

Hi all...I have come here as you guys are always able to give sterling advice!

I have searched for this solution but cannot find it anywhere!

The VBA itself will be very simple (I anticipate) but not sure the best method to use. I have a named range called "Sort Order" that is present on a sheet called "STATIC". I have data on a sheet called, funnily enough, "DATA".

I would like the columns in "DATA" to be sorted based on the list contained in "Sort Order" (which is at present in STATIC!A1:A10).

If anybody could help this would be most appreciated :S There would need to be some way of catching errors so if "Sort Order" contained a field that wasnt there, the whole thing wouldn't fall over

Any help would be great....

[farrukh]

Hi Theta,

To best describe your issue please attached the sample excel file.

Thanks
Farrukh

[mdmackillop]

[vba]
Option Explicit
Sub OrderSheets()
Dim r As Range
Dim i As Long
Dim sh As Worksheet
Set r = Range("SortOrder")
On Error Resume Next
For i = r.Count To 1 Step -1
Set sh = Sheets(r(i).Value)
If Not sh Is Nothing Then
sh.Move before:=Sheets(1)
Set sh = Nothing
End If
Next
End Sub

[/vba]

Wasn't thinking and applied code to sheets instead of columns. Ca you adjust the code?

[mikerickson]

Perhaps[VBA]Sub test()
Dim listSource As Range
Dim rangeToSort As Range

Set listSource = Sheet1.Range("a1:A10")
Set rangeToSort = Sheet1.Range("F1:H4")

Application.AddCustomList ListArray:=listSource.Value

With rangeToSort
.Sort Key1:=.Cells(1, 1), Orientation:=xlLeftToRight, ordercustom:=Application.CustomListCount
End With

Application.DeleteCustomList Application.CustomListCount
End Sub[/VBA]

[theta]

Sorry here is an example

http://www.mediafire.com/?y969c6649ennmtp

It is for sorting columns, not ranges.

I like both approaches, they both use different methods (can you explain the list method?)

md yours looks very simple, could you change the sheet references to use columns instead... ?

[theta]

Also, further from last....I have the following in a module called "PublicSubs" so they can be referenced (for finding the column or the last cell)

Function Last(choice As String, rng As Range)
'Purpose: Find LAST row, col or cell address

    Dim lrow As Long
    Dim lcol As Long

    Select Case choice

    Case "Row"
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        after:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0
        
    Case "Col"
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        after:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0
        
    Case "Cell"
        On Error Resume Next
        lrow = rng.Find(What:="*", _
                       after:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        after:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrow, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function

Function FindFieldCol(ByRef oWS As Worksheet, sField As String) As Long
'Purpose: Find column position of a field in an XML data sheet
 
    Dim c As Long, nLastCol As Long
    
    nLastCol = Last("Col", oWS.UsedRange)
    FindFieldCol = 0
    For c = 1 To nLastCol
        If oWS.Cells(1, c) = Trim(sField) Then FindFieldCol = c
    Next c

End Function

[mikerickson]

Chaning the constants in my code gave this.
Which gave the desired results. (Minus the typo in the example)

[VBA]Sub test()
Dim listSource As Range
Dim rangeToSort As Range

Set listSource = Sheet1.Range("B1:B10")
Set rangeToSort = Sheet2.Range("a1:f26")

Application.AddCustomList ListArray:=listSource.Value

With rangeToSort
.Sort Key1:=.Cells(1, 1), Orientation:=xlLeftToRight, ordercustom:=Application.CustomListCount
End With

Application.DeleteCustomList Application.CustomListCount
End Sub[/VBA]

[theta]

Hmmm...it keeps sorting it alphabetically!? Not using the custom list

Also want it so that if there was a column not included in the custom list, it will just be shunted to the end

I thought it would be easier to pick out matchin columns then place them based on their position in the list. This would leave any columns that don't have a position on the list, and prevent list typos from having any effect?

[mdmackillop]

[VBA]Option Explicit
Sub OrderColumns()
Dim r As Range
Dim i As Long
Dim Col As Range
Dim Data As Range

Set r = Range("SortOrder")
Set Data = Sheets("data").Range("A1").CurrentRegion.Rows(1)

On Error Resume Next
For i = r.Count To 1 Step -1
Set Col = Data.Find(r(i).Value, lookat:=xlWhole)
If Not Col Is Nothing Then
Col.EntireColumn.Cut
Columns("A:A").Insert
Set Col = Nothing
End If
Next
End Sub
[/VBA]