Macro Assistance - Extra Column Added to Code - Will Not Sort Chronologically Anymore

[Justinian]

I have a spreadsheet that runs a macro to do the following:

I have a list of employees, thousands of rows. The code looks for the last two digits of the employee numbers and groups them together on separate tabs as follows:


01,44,79
02
05,08
06
07,11
10
13
15
18,30,70
19,19A,26, 26A
20
21
22
23
24
28
29
31
33
34
36
37
43
54
59,89
73
76
78
AA through ZZ

So basically, on the first tab, I have thousands of employee numbers and when I run the macro, tab #2 is all employee numbers ending in 01, 44, and 79; tab 3 is all employee numbers ending in 02, etc. You get the idea. Hiker 95 helped me with the code but my manager changed the report - he added an extra column so the code Hiker wrote works, but it does not place the tabs to the right of the summary tab in chronological order anymore. If I post the code, can someone help me alter it? All that changed is Z is no longer the last column, AA is.

Sub CreateEmployeeNumberSheets()
' hiker95, 08/28/2014, ME800316
Dim ws As Worksheet, en As Worksheet, h As String
Dim c As Range, n As Range, nr As Long
Application.ScreenUpdating = False
Set ws = Sheets("Summary")
Set en = Sheets("EN_Sheets")
With ws
For Each c In .Range("I2", .Range("I" & Rows.Count).End(xlUp))
If Right(c, 2) Like "[0-9][0-9]" Then
Set n = en.Columns(1).Find(Right(c, 2), LookAt:=xlWhole)
If Not n Is Nothing Then
h = en.Cells(n.Row, 2).Value
If Not WorksheetExists(h) Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = h
ws.Range("A1:Z1").Copy Destination:=Sheets(h).Range("A1")
Application.CutCopyMode = False
End If
With Sheets(h)
nr = Sheets(h).Cells(Sheets(h).Rows.Count, "I").End(xlUp).Row + 1
ws.Range("A" & c.Row & ":Z" & c.Row).Copy Destination:=Sheets(h).Range("A" & nr)
Application.CutCopyMode = False
End With
End If
ElseIf Right(c, 3) Like "[0-9][0-9][A-Z]" Then
If Right(c, 3) = "19A" Or Right(c, 3) = "26A" Then
h = "19, 19A, 26, 26A"
If Not WorksheetExists(h) Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = h
End If
With Sheets(h)
ws.Range("A1:Z1").Copy Destination:=Sheets(h).Range("A1")
Application.CutCopyMode = False
nr = Sheets(h).Cells(Sheets(h).Rows.Count, "I").End(xlUp).Row + 1
ws.Range("A" & c.Row & ":Z" & c.Row).Copy Destination:=Sheets(h).Range("A" & nr)
Application.CutCopyMode = False
End With
End If
ElseIf Right(c, 2) Like "[A-Z][A-Z]" Then
h = "AA - ZZ"
If Not WorksheetExists(h) Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = h
End If
With Sheets(h)
ws.Range("A1:Z1").Copy Destination:=Sheets(h).Range("A1")
Application.CutCopyMode = False
nr = Sheets(h).Cells(Sheets(h).Rows.Count, "I").End(xlUp).Row + 1
ws.Range("A" & c.Row & ":Z" & c.Row).Copy Destination:=Sheets(h).Range("A" & nr)
Application.CutCopyMode = False
End With
End If
Next c
End With
Application.ScreenUpdating = True
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

 

[Justinian]

That did not seem to work either. Thank you for trying.

 

[Benzula]

Okay, well I wish you luck! And if hiker can help you fix it, I'd love to see what he did differently to do so. Would help me to learn a little more too. So if you do, please post the code here.

Thanks!