Thanks:  0
Likes:  0

1. ## Data Sorting VBA/Code

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!

2. ## Re: Data Sorting VBA/Code

Hi,

Test the following code:

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:

Code:
`.Rows(lngRow).EntireRow.Delete`
Hope it works for you.