Advanced sorting in excel - excel

Question

I have a data in excel in the format:
Description Name Percent
Always A 52
Sometimes A 23
Usually A 25
Always B 60
Sometimes B 30
Usually B 15
Always C 75
Sometimes C 11
Usually C 14
I want to sort this data:
For each name the sequence of description has to be same (eg: always followed by sometimes followed by usually) but for three names A, B and C, I want to sort the always percent from smallest to largest. Eg: I want the above example to look like this after sorting:
Description Name Percent
Always C 75
Sometimes C 11
Usually C 14
Always B 60
Sometimes B 30
Usually B 15
Always A 52
Sometimes A 23
Usually A 25
The always percent of name C was highest and always percent of name A was lowest. I hope I was able to explain it. I would really appreciate your help regarding the same.

Answer 1

Here's a vba routine to perform this sort:
Select the data on the sheet and run SortList
Important: this code assumes that the Always, Sometimes, Usually data is grouped by Name (as in your sample data)
Method:
Sub SortList()
Dim dat As Variant
Dim rng As Range
Dim newDat() As Variant
Dim always() As Long
Dim i As Long
Set rng = Selection
If rng.Columns.Count <> 3 Then
MsgBox "Select a range with 3 columns", vbCritical + vbOKOnly
Exit Sub
End If
If StrComp(rng.Cells(1, 1), "Description", vbTextCompare) = 0 Then
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 3)
End If
dat = rng
ReDim always(1 To UBound(dat, 1) / 3)
For i = 1 To UBound(dat)
If StrComp(dat(i, 1), "Always", vbTextCompare) = 0 Then
always(i \ 3 + 1) = i
End If
Next
QuickSort dat, always, LBound(always, 1), UBound(always, 1)
ReDim newDat(1 To UBound(dat, 1), 1 To 3)
For i = 1 To UBound(always)
newDat((i - 1) * 3 + 1, 1) = dat(always(i), 1)
newDat((i - 1) * 3 + 1, 2) = dat(always(i), 2)
newDat((i - 1) * 3 + 1, 3) = dat(always(i), 3)
' Assumes original data is sorted in name order
newDat((i - 1) * 3 + 2, 1) = dat(always(i) + 1, 1)
newDat((i - 1) * 3 + 2, 2) = dat(always(i) + 1, 2)
newDat((i - 1) * 3 + 2, 3) = dat(always(i) + 1, 3)
newDat((i - 1) * 3 + 3, 1) = dat(always(i) + 2, 1)
newDat((i - 1) * 3 + 3, 2) = dat(always(i) + 2, 2)
newDat((i - 1) * 3 + 3, 3) = dat(always(i) + 2, 3)
Next
rng = newDat
End Sub
Private Sub QuickSort(ByRef dat As Variant, ByRef Field() As Long, ByVal LB As Long, ByVal UB As Long)
Dim P1 As Long, P2 As Long, Ref As Variant, TEMP As Long
P1 = LB
P2 = UB
Ref = dat(Field((P1 + P2) / 2), 3)
Do
Do While dat(Field(P1), 3) > Ref
P1 = P1 + 1
Loop
Do While dat(Field(P2), 3) < Ref
P2 = P2 - 1
Loop
If P1 <= P2 Then
TEMP = Field(P1)
Field(P1) = Field(P2)
Field(P2) = TEMP
P1 = P1 + 1
P2 = P2 - 1
End If
Loop Until (P1 > P2)
If LB < P2 Then Call QuickSort(dat, Field, LB, P2)
If P1 < UB Then Call QuickSort(dat, Field, P1, UB)
End Sub
The Quicksort is adapted from this answer by Konrad Rudolph

Answer 2

It might be easier with ADO:
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim i As Integer
strFile = "C:\Docs\Book2.xlsm"
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''Comment out the connection string, as appropriate.
''This is the Jet 4 connection string, for < 2007:
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''ACE, for 2007 -
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT s1.[Description], s1.[Name], s1.[Percent] " _
& "FROM [Sheet3$] s1 " _
& "INNER JOIN (SELECT s.Name, s.Percent " _
& "FROM [Sheet3$] s " _
& "WHERE s.Description='Always') As s2 " _
& "ON s1.Name = s2.Name " _
& "ORDER BY s2.Percent DESC, s1.Description"
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet or location for the results
With Worksheets("Sheet4")
For i = 1 To rs.Fields.Count
.Cells(1, i) = rs.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset rs
End With
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Answer 3

Sort by Description. Add this formula to column D =RANK(VLOOKUP(INDIRECT("B"&ROW()),B:C, 2, FALSE),C:C ) and sort column D with Smallest to Largest.