Data Sorting VBA/Code

Justijb

New Member
Joined
Aug 16, 2016
Messages
43
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!
 

Some videos you may like

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
Joined
Aug 28, 2016
Messages
628
Office Version
365, 2013
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,096,400
Messages
5,450,176
Members
405,590
Latest member
bal016

This Week's Hot Topics

Top