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!
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!
VBA Code:
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