# Data Sorting VBA/Code

#### Justijb

##### New Member
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!

### Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

#### JustynaMK

##### Well-known Member
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.