Grouping duplicated data

paulystix

New Member
Joined
Mar 25, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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!

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
 

Attachments

  • 2022-03-25_13-25-30.png
    2022-03-25_13-25-30.png
    19 KB · Views: 9
  • 2022-03-25_13-26-11.png
    2022-03-25_13-26-11.png
    21.3 KB · Views: 9

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

paulystix

New Member
Joined
Mar 25, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Bump, if anyone can offer some insight I'd really appreciate it!
 

Forum statistics

Threads
1,181,429
Messages
5,929,842
Members
436,698
Latest member
darshanw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top