Grouping duplicated data

[paulystix]

I recently built a sheet that will help me duplicate records by concatenating specific data, last four of the SSN and first 3 letters of the first name, which then duplicates this data into two transactions. It will work perfectly to group the transaction 3 and 4 together BUT only if I sort two rows together; NYSLRS ID and first 3 of the first name. I really want to sort it by last name but I think the spaces in the sheet are causing an issue. I'm lost how to sort alphabetically by last name and simultaneously group the transaction 3 & 4 together.

In the one screenshot it is sort alphabetically by last name but notice it only has Transaction 3's grouped together. I attached another screenshot of what I actually want it to do. I also attached the current VBA log. I'm sure the code is sloppy as well lol. Any help is greatly appreciated!

Sub Employercleanup()
'
' Employercleanup Macro
'
Dim RowCount As Integer
   
    RowCount = Range("A1048576").End(xlUp).Row

If RowCount < 1 Then Exit Sub
Application.ScreenUpdating = False
       Range("E4").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("E4:E16"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "Last 4 of social"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "First 3 of first name"
    Range("E6:E7").Select
    Range("E7").Activate
    Columns("C:C").ColumnWidth = 19.57
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").ColumnWidth = 16.86
    Columns("D:D").EntireColumn.AutoFit
    Range("C5").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(RC[2],4)"
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[2],3)"
    Range("C5").Select
    Selection.AutoFill Destination:=Range("C5:C" & RowCount)
    ' Range("C5:C2000").Select
    Range("D5").Select
    Selection.AutoFill Destination:=Range("D5:D" & RowCount)
    ' Range("D5:D2000").Select
    ' Range("R14").Select
    '
' maketext Macro
'

'

    Range("C5:C" & RowCount).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("D5:D" & RowCount).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    '
' copypaste Macro
'

'
    Range("A5:D" & RowCount).Select
    Selection.Copy
    Range("A" & RowCount + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Transaction"
    Range("A4").Font.Bold = True
    rowcount1 = Range("B1048576").End(xlUp).Row
    Range("A5:A" & RowCount).Value = "3"
    Range("A" & RowCount + 1, "A" & rowcount1).Value = "4"
    Range("A4:H4").HorizontalAlignment = xlCenter
    Range("A4:H4").VerticalAlignment = xlCenter
    Range("A4:H" & rowcount1).Select
    Application.ScreenUpdating = True
    Range("A5").Select
    Selection.Activate
    
End Sub

 

[paulystix]

Bump, if anyone can offer some insight I'd really appreciate it!