Data Sorting VBA/Code

[Justijb]

Hello Friends,

So this might be an easy solution and I usually have great success with this forum so thank you in advance! I have a data set in columns A-T.

I need to sort on column F, same unique identifier through rows 2-128. Each row has different data after column I and I need to bring up all the same identifiers from column F on one singe row so the data is side by side from rows 2-128 but all the same unique identifier.

A B C D E F G H I J K
00000000 XXX 0000 XYXY 0000 Same ID 1 XXXX Different Different Data
00000000 XXX 0000 XYXY 0000 Same ID 1 XXXX Different Different Data

TO

A B C D E F G H I J K L M N O P Q
00000000 XXX 0000 XYXY 0000 Same ID 1 XXXX Different Different Data Same ID 1 XXXX Different Data


Each unique identifier in column F is alphanumeric and varies in how many rows of data there are.

Any assistance would be very helpful. Thanks again!

 

[JustynaMK]

Hi,

Test the following code:

Sub SortData()
    Dim lngRow              As Long
    Dim lngOrigRow          As Long
    Dim lngOrigCol          As Long


    With ActiveSheet
        For lngRow = 128 To 2 Step -1
            If Application.WorksheetFunction.CountIf(.Range("I2:I" & lngRow), .Range("I" & lngRow).Value) > 1 Then
                lngOrigRow = Application.WorksheetFunction.Match(.Range("I" & lngRow).Value, .Range("I1:I" & lngRow - 1), 0)
                lngOrigCol = Application.Rows(lngOrigRow).Cells.SpecialCells(xlCellTypeConstants).Count
                .Range("J" & lngRow & ":K" & lngRow).Copy
                .Cells(lngOrigRow, lngOrigCol + 1).PasteSpecial (xlPasteValues)
                .Range("L" & lngRow).Value = "to be deleted"
                '.Rows(lngRow).EntireRow.Delete
            End If
        Next lngRow
    End With
    
    Application.CutCopyMode = False
End Sub

The code is looking for duplicate ID code in column I. Once identified, it will copy the values into the first occurrence of this ID code (starting with column L).
I have also added a code for "to be deleted" mark. Once you make sure the code works as expected, uncomment the following line in order to delete all marked rows:

.Rows(lngRow).EntireRow.Delete

Hope it works for you.