Custom Horizontal Sort (VBA)

[lneidorf]

Hi there.

I've put together a small bit of code that applies a custom sort order horizontally, which is defined by the contents of a range of cells on another tab.

Here's my code:

Sub Custom_Sort()

With Sheets("Data")
   Application.AddCustomList ListArray:=Sheets("Sort Order").Range("A2:A99")   
   Varlist = Application.CustomListCount
   Varlist = Varlist + 1
   
   .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
   OrderCustom:=Varlist, MatchCase:=False, Orientation:=xlLeftToRight
   'Delete list
   Application.DeleteCustomList (Varlist - 1)
End With

End Sub

Here's how this works at present:

A) On the "Sort Order" tab, I list the header names of columns I want to sort horizontally. They appear in column A, starting at A2, in the order that they should be sorted. Cell A1 is a header cell not involved in the custom sort list.

B) On the "Data" tab, I paste the raw export of an extensive SQL report, containing many more columns than I need.

C) This macro is meant to sort the contents of the "Data" sheet according to the header names listed in column A of the "Sort Order" tab.


My code works. But there are two enhancements I'd like to make here:

1) My code to define the range that is used to create the custom sort list is static [.Range("A2:A99")]. I'd like to make this range dynamic, beginning at cell A2 and extending down column A until the last contiguous used cell. I've tried things like the following to no effect:

   Application.AddCustomList ListArray:=Sheets("Sort Order").Range("A2").End(xlDown)

2) On the "Data" tab, I'd like to delete any columns whose header values are not in my list of sort values on the "Sort Order" tab.

Any ideas would be most appreciated!

Thanks.

 

[S.H.A.D.O.]

Give this a try for the first part...

Application.AddCustomList ListArray:=Sheets("Sort Order").Range("A2" & Rows.Count).End(xlUp).Row.End(xlUp)

I hope this helps!