0

I have scoured Google and the Stack for examples of what I am trying to do, while I have found some examples the perform part of what I am trying to do, I am having trouble accomplishing the desired result. I have included the below code which seems to look like it will do what I want to accomplish. Unfortunately I get a "Subscript out of range" which I assume has to do with my syntax.

Per the screenshots included I am trying to sort the columns found on "Sheet2" by the order of the values found in Column A on "Sheet1". Conceptually,

I figure the best route would be to assign the values in sheet1 to an array, the columns in sheet2 to an array and then order array2 according to the array1.

Any thoughts on how to accomplish this? Any help is appreciated:

Public Sub sortColumn()
Dim rng As Range
Dim i As Integer
Dim J As Integer
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
Dim Arr As Variant


nams = Array(Worksheets("Sheet1").Range("A1:A350").Value2)

Set rng = Worksheets("Sheet2").Range("B1:JS1")
For i = 1 To rng.Columns.Count
    For J = i To rng.Columns.Count
        For F = 0 To UBound(nams)
            If nams(F) = rng(J) Then Dex = F: Exit For
        Next F
        If F < i Then
            Temp = rng.Columns(i).value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
    Next J
Next i


End Sub

Above code, as stated above, results in a "Sub script out of range". I have checked by range names and they are valid. Below graphics show what I am working with:

enter image description here

enter image description here

pnuts
  • 58,317
  • 11
  • 87
  • 139
Singularity20XX
  • 321
  • 5
  • 20
  • You could create a custom list based on sheet one, sort sheet two left to right and then delete the custom list you just created. Along the same lines as [this](http://stackoverflow.com/questions/6100944/code-an-excel-vba-sort-with-a-custom-order-and-a-value-containing-commas) – Scott Craner Sep 15 '15 at 19:20
  • When you create a custom list, the list remains static. The values on sheet1, unfortunately, constantly change, – Singularity20XX Sep 15 '15 at 19:25
  • Each time you run the code it will look to sheet one and create a new custom list based on whats there. Then when you have sorted sheet two it gets deleted. load everything into an array, pass that array into the custom list. It will change each time it is run. – Scott Craner Sep 15 '15 at 19:29
  • I see that the custom list changes. However I tried every variation of custom sort on sheet2 – Singularity20XX Sep 15 '15 at 20:16

2 Answers2

0

Can be achieved without VBA if a row is added to the top of the second sheet with a formula such as:

=MATCH(B2,Sheet1!$A:$A,0)  

in B1 copied across to suit and then ColumnsB onwards sorted on Row1.

pnuts
  • 58,317
  • 11
  • 87
  • 139
0

As discussed in the comments of the OP.

First create a custom list based on the contents on sheet1 (I will put them all together):

Dim cstListArr() As Variant
cstListArr = wst1.Range(Range("A1"), Range("A1").End(xlDown))
Application.AddCustomList ListArray:=cstListArr

then sort left to right

Set srtRng = wst2.Range(Range("B1"), Range("B1").End(xlDown).End(xlToRight))

wst2.Sort.SortFields.Clear
srtRng.Sort Key1:=wst2.Range("B1:JS1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal

then get rid of the custom sort just created.

Application.DeleteCustomList Application.CustomListCount

So all together:

Dim wst1 As Worksheet
Dim wst2 As Worksheet
Set wst1 = ActiveWorkbook.Worksheets("Sheet1")
Set wst2 = ActiveWorkbook.Worksheets("Sheet2")
Dim srtRng As Range

wst1.Activate
Dim cstListArr() As Variant
cstListArr = wst1.Range(Range("A1"), Range("A1").End(xlDown))
Application.AddCustomList ListArray:=cstListArr

wst2.Activate
Set srtRng = wst2.Range(Range("B1"), Range("B1").End(xlDown).End(xlToRight))

wst2.Sort.SortFields.Clear
srtRng.Sort Key1:=wst2.Range("B1:JS1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
    Orientation:=xlLeftToRight, DataOption1:=xlSortNormal


Application.DeleteCustomList Application.CustomListCount
Scott Craner
  • 148,073
  • 10
  • 49
  • 81