Sort Column Based on Another Column Order of Values - vba

Question

I have two columns in spreadsheet1:
Col1 Col2
1 PDC
2 SR3
3 PDC
4 VBM
5 VBM
6 GAL
7 VBM
8 GAL
9 PDC
I have 1 column in spreadsheet2:
Col1
PDC
SR3
VBM
GAL
How can I sort Col1 and Col2 from spreadsheet1 based on the order in spreadsheet2 Col1?

Answer 1

Try this code:
Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim rng As Range
'if workbook2 is already opened
Set wb = Workbooks("Book2") ' change Book2 to suit
'if workbook2 is not opened
'Set wb = Workbooks.Open("C:\Book2.xlsx")
'change sheet1 to suit
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
'change sheet2 to suit
Set ws2 = wb.Worksheets("Sheet2")
With ws1
'change column B to column with your values "PDC", "SR3" and so on
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
'change to address of range you wnat to sort
Set rng = .Range("A1:B" & lastrow)
With rng.Offset(, rng.Columns.Count).Resize(, 1)
.EntireColumn.Insert
.Offset(, -1).FormulaR1C1 = "=MATCH(RC[-1],'[" & wb.Name & "]" & ws2.Name & "'!C1:C1,0)"
.Offset(, -1).Value = .Offset(, -1).Value
End With
With rng.Resize(, rng.Columns.Count + 1)
.Sort Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlGuess
.Cells(1, .Columns.Count).EntireColumn.Delete
End With
End With
wb.Close
End Sub
Explanaiton:
There're two workbooks. Code should be places in first workbook (where you want to sort range)
The main idea is to add temporary column with formula like =MATCH(B1,[Book2]Sheet2!A:A,0) to get row numbers of values from column B (workbook1) in column A (workbook2).
Sort range based on this numbers.
Delete temporary column
Notes:
Next line assumed that column with "PDC", "SR3" (in workbook1) is last in selected range (Set rng = .Range("A1:B" & lastrow)):
.Offset(, -1).FormulaR1C1 = "=MATCH(RC[-1],'[" & wb.Name & "]" & ws2.Name & "'!C1:C1,0)"
if it's not true, change RC[-1] to, say RC[-2] if this column is last but one and so on.
C1:C1 part of formula means that in workbook2 column with "PDC", "SR3" is column A (column №1). If it's not true, change it to, say, C5:C5, which means that column is E (column №5).

Answer 2

I found this code which seems a bit simpler and works great.
Sub NewSortTest()
Dim keyRange As Variant
Dim sortNum As Long
keyRange = ActiveWorkbook.Worksheets("Sheet2").Cells.Range("A1:A10").Value
Application.AddCustomList ListArray:=keyRange
sortNum = Application.CustomListCount
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:B20")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub