Modify existing code to sort in a particular order (non alphabetical)

[PP]

I have some existing code that will sort a range alphabetically from A - Z:

Code:

Private Sub CommandButton3_Click()
Columns("C:C").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("C1:C30").Select
Selection.Copy
Range("D24").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

However, I'd love to modify this so that the letter P is sorted at the top of the list, followed by M then D, so in a 6 cell list with the following characters in each cell:

D1
M2
P1
P2
M1
D2

It would be sorted to:

P1
P2
M1
M2
D1
D2

How can I modify the first part of the code (not the transpose bit) to accomplish this?

 

[p45cal]

There are secveral ways to approach this and I can think of 3 just now, but I'm just going out for several hours so will only outline them.
1. Sort as you have done, then Ps will be together, the Ms too, as well as the Ds; so just move the three blocks to the top by cut and paste in vba.
2. Before sorting, run through the list prefixing the Ps with say "AA", the Ms with "BB" and the Ds with "CC", then sort, then remove the prefixes.
3. Using another column, placing a 1 next to the Ps, a 2 next to the Ms and a 3 next to the Ds, then sort primarily on this new column, secondarily on column C, then if you want, remove the data in the new column.

All in vba, no manual entering of data needed.

 

[PP]

Another member kindly wrote this code and I have no expertise in this field ... if anyone can help and write a few lines to accomplish this it would be brilliant and save me hours of cutting and pasting over the next few weeks!

 

[mirabeau]

Try this on your test data and see if it works for you

Sub sorting()
Dim k&, q&, i&, lr&
lr = Range("C" & Rows.Count).End(3).Row + 1
k = 1: q = 1
With Range("C1").Resize(lr)
    .Sort .Cells(1), 2, Header:=xlNo
For i = 2 To lr
    If Left(.Cells(i), 1) <> Left(.Cells(i - 1), 1) Then
        .Cells(q).Resize(k).Sort .Cells(q), 1, Header:=xlNo
        q = i
        k = 1
    Else
       k = k + 1
End If
Next i
End With
End Sub

 

[p45cal]

mirabeau's interpretation may be correct, that you(PP) want the list sorted in reverse alphabetic order, but in ascending numeric order. (I've been working on just putting those beginning with P, M and D at the top.)
Which is it?

Also, does C1 contain a header (to exclude it from the sorting if necessary)?

 

[p45cal]

mirabeau,
I tried your code and I think it might need a little tweak:

.Cells(q).Resize(k).Sort .Cells(q), 1, Header:=xlNo
to become
If k > 1 then .Cells(q).Resize(k).Sort .Cells(q), 1, Header:=xlNo

since when k is 1, (when there's only one instance of a given first letter) the whole column gets sorted (at least in xl2003)!

 

[mirabeau]

hey p45cal,

thanks for the useful observation

i was doing that late and night and only looked at it for the posted sample data which didn't contain the case you indicate

but the case you indicate is obviously relevant in any realistic application

 

[PP]

Hi Guys,

Thank you so much for your help