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.... :D

[farrukh]

Hi Theta,

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

Thanks
Farrukh

[mdmackillop]

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



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

[mikerickson]

PerhapsSub 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

[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)

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

[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]

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