Sort with macro - Excel 2007

[EricL89]

I've got a current macro which I'm using that works perfectly, at this point I'm just fine-tuning it (it's the same project from my previous thread).

I'd like to add some code that organizes the spreadsheet based on column B, "Producer". The cells contain the initials of all my coworkers, and I'd like to sort them alphabetically. However, I want to sort it in a way that the oldest entries remain on top for each group of initials. Each row is a current prospect, thus I want to keep the oldest prospects at the top for each producer.

New prospects will just be added in the next available row, and the macro needs to be able to identify which prospects need to get sorted.

For example, if the current sheet looks like this:

Prospect	Producer
Prospect1	DB
Prospect2	DB
Prospect11	DB
Prospect3	FS
Prospect10	FS
Prospect4	GB
Prospect5	GB
Prospect8	GB
Prospect7	RA
Prospect9	RA
Prospect12	FS
Prospect13	DB
Prospect14	RA
Prospect15	GB

<tbody>
</tbody>

I want it to look like this afterwards:

Prospect	Producer
Prospect1	DB
Prospect2	DB
Prospect11	DB
Prospect13	DB
Prospect3	FS
Prospect10	FS
Prospect12	FS
Prospect4	GB
Prospect5	GB
Prospect8	GB
Prospect15	GB
Prospect7	RA
Prospect9	RA
Prospect14	RA

<tbody>
</tbody>

Can anybody lend a hand? Thanks!

Eric

 

[JoeMo]

This assumes that the header Prospect is in A1 and that your producers initials are always two characters in length.

Sub SortProspects()
Dim lR As Long, vA As Variant, i As Long, j As Long, Temp1 As _
    Variant, Temp2 As Variant, Temp3 As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Columns("A").Insert
Range("A1").Value = "Temp"
Range("A2:A" & lR).Formula = "=C2&RIGHT(B2,LEN(B2)-SEARCH(""t"",B2))"

Range("A1").CurrentRegion.Sort key1:=[A2], order1:=xlAscending, Header:=xlYes
vA = Range("A2:C" & lR).Value
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
'        If Left(vA(i, 1), 2) = Left(vA(j, 1), 2) Then
            If Left(vA(i, 1), 2) = Left(vA(j, 1), 2) And Val(Right(vA(i, 1), Len(vA(i, 1)) - 2)) > Val(Right(vA(j, 1), Len(vA(j, 1)) - 2)) Then
                Temp1 = vA(i, 1)
                Temp2 = vA(i, 2)
                Temp3 = vA(i, 3)
                vA(i, 1) = vA(j, 1)
                vA(j, 1) = Temp1
                vA(i, 2) = vA(j, 2)
                vA(j, 2) = Temp2
                vA(i, 3) = vA(j, 3)
                vA(j, 3) = Temp3
            End If
'        End If
    Next j
Next i
Range("A2:C" & lR).Value = vA
Columns("A").Delete
Application.ScreenUpdating = True
End Sub

 

[EricL89]

Thanks, Joe! I should have mentioned that the headers are in row 3, with the prospects starting in row 4. However, it looks like I'll only need to change the code to adjust for the row numbers (i.e. change A1 to A3, A2 to A4, B2 to B4, etc.), correct? Additionally, the data spans across columns A-K, will any changes need to be made to account for that? I don't have access to my computer with the file right now, but I should be able to later (I hope).

Thanks again!

 

[JoeMo]

Thanks, Joe! I should have mentioned that the headers are in row 3, with the prospects starting in row 4. However, it looks like I'll only need to change the code to adjust for the row numbers (i.e. change A1 to A3, A2 to A4, B2 to B4, etc.), correct? Additionally, the data spans across columns A-K, will any changes need to be made to account for that? I don't have access to my computer with the file right now, but I should be able to later (I hope).

Thanks again!

Always good to "mention" all the facts in your initial post, because they almost always have an impact. Here's a revision that accounts for (hopefully) all the facts as I understand them. Assumes Prospects in column A and Producer in column B.

Sub SortProspects()
Dim lR As Long, vA As Variant, i As Long, j As Long, k As Long, cols As Long, Temp() As Variant
lR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Columns("A").Insert
Range("A3").Value = "Temp"
Range("A4:A" & lR).Formula = "=C4&RIGHT(B4,LEN(B4)-SEARCH(""t"",B4))"
cols = Range("A3").CurrentRegion.Columns.Count
Range("A3").CurrentRegion.Sort key1:=[A4], order1:=xlAscending, Header:=xlYes
vA = Range(Cells(4, "A"), Cells(lR, cols)).Value
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    For j = i + 1 To UBound(vA, 1)
            If Left(vA(i, 1), 2) = Left(vA(j, 1), 2) And Val(Right(vA(i, 1), _
                Len(vA(i, 1)) - 2)) > Val(Right(vA(j, 1), Len(vA(j, 1)) - 2)) Then
                ReDim Temp(1 To UBound(vA, 2))
                For k = 1 To UBound(vA, 2)
                    Temp(k) = vA(i, k)
                    vA(i, k) = vA(j, k)
                    vA(j, k) = Temp(k)
                Next k
                Erase Temp
            End If
    Next j
Next i
Range(Cells(4, "A"), Cells(lR, cols)).Value = vA
Columns("A").Delete
Application.ScreenUpdating = True
End Sub