Merge Duplicates

[coolkiran]

Hi To All

I have an excel file with 10,000 of rows, in that Column V contains SSN Numbers.

When i checked that column, i can find lot duplicates in Column V.

So i need to merge that duplicate rows to single row.

Eg: Column Name A B C D
Row number 1 a b e
Row number 2 b b

Here, say i need to merge duplicates from Column C:

Then the final Output like

Column Name A B C D
Row number 1 a b b e

Please assist me on this.

 

[shrivallabha]

A file upload will be better as it is bit difficult to see what is getting merged. Few example lines of "Before" and "After" should get you a good solution from any one on the forum.

 

[coolkiran]

Thanks Shri.

I am uploading a sample file.

 

[shrivallabha]

Very good. If there are more than one data filled cells in the same column for one Sl No e.g.

Day | Month | Year | Sl No
Sun | Jan13 | 2013 | 1
Mon | Feb14 | 2014 | 1

Then what results will you expect? Make sure your sample matches your real data otherwise I can see there will be lot of back and forth like "This is not working because this setting should be this...!"

 

[coolkiran]

Thanks Shri,

I am getting simple data like the file i have attached.

• For same SL. No, i will not get different data, i will get either one row cell value will blank, or both matching rows with same cell value. If one row cell value is blank, when merging i need to fill data which has cell value with blank.

Here is example
Day | Month | Year | Sl No
Sun | Jan13 | | 1
Sun | Jan13 | 2013 | 1
Output i am expecting:
Day | Month | Year | Sl No
Sun | Jan13 | 2013 | 1
Or Another possibilities :
Day | Month | Year | Sl No
Sun | Jan13 | 2013 | 1
Sun | Jan13 | 2013 | 1
Output i am expecting :
Day | Month | Year | Sl No
Sun | Jan13 | 2013 | 1
Only these two scenarios i will get.

 

[shrivallabha]

Test this code on a backup and see if it works for you.

Option Explicit
Public Sub Process_Data()
Dim lngLastRow As Long, i As Long, j As Long
Dim rngSortCol As Range, rngDelete As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

'\\ This will search for sort column and then sort the data on this column.
'\\ Also find last row for fixing up header range
Set rngSortCol = Cells.Find("SL NO", [A1], xlValues, xlWhole, xlByRows, xlNext, False)
lngLastRow = Cells.Find("*", [A1], xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

'\\ Sort range if not sorted on SL NO
With Range(Cells(rngSortCol.Row, 1), Cells(lngLastRow, rngSortCol.Column))
    .Sort rngSortCol, xlAscending, , , , , , xlGuess
End With

'\\ Fill empty cells with data so that all rows with more than one occurrence of SL NO
'\\ become duplicates
For i = rngSortCol.Row + 1 To lngLastRow
    For j = 1 To rngSortCol.Column - 1
        If Len(Cells(i, j).Value) = 0 Then
            If Cells(i, rngSortCol.Column).Value = Cells(i + 1, rngSortCol.Column).Value Then
                Cells(i, j).Value = Cells(i + 1, j).Value
            ElseIf Cells(i, rngSortCol.Column).Value = Cells(i - 1, rngSortCol.Column).Value Then
                Cells(i, j).Value = Cells(i - 1, j).Value
            End If
        End If
    Next j
    '\\ Mark those duplicates for deletion as we go through
    If Cells(i, rngSortCol.Column).Value = Cells(i - 1, rngSortCol.Column).Value Then
        If rngDelete Is Nothing Then
            Set rngDelete = Cells(i, 1)
        Else
            Set rngDelete = Union(rngDelete, Cells(i, 1))
        End If
    End If
Next i

'\\ Finally Delete all duplicate occurrences
If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub