CODEWITHSUNDEEP
excelvba
Robert E
Robert E

Reputation: 740

Merging rows in an Excel document with the same email and preserving merged row data

I have an excel sheet of around 50,000 records of something like this:

email   product  info   moreinfo
[email protected]   866   data   data1
[email protected]   960   data   data1
[email protected]   976   data   data1
[email protected]   884   data   data1
[email protected]   1010   data   data1
[email protected]   834   data   data1
[email protected]   981   data   data1
[email protected]   935   data   data1
[email protected]   832   data   data1
[email protected]   934   data   data1

I need to convert it to something like this:

email   product   info   moreinfo
[email protected]   866   data   data1
[email protected]   960   data   data1
[email protected]   976,884   data   data1
[email protected]   1010   data   data1
[email protected]   834   data   data1
[email protected]   981   data   data1
[email protected]   935,832,934   data   data1

I need rows with duplicate emails to be merged into one and information from column B to be merged into one record for that email address. I've tried a few macros but to no avail. Can you help me? I'm a bit confused here. Thanks!

Edit: I'm using Excel 2011 on the Mac.

Upvotes: 0

Views: 320

Answers (2)

nutsch
nutsch

Reputation: 5962

Try this macro:

Sub ConsolidateRows()
'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows.

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant

'**********PARAMETERS TO UPDATE****************
Const strMatch As String = "A"    'columns that need to match for consolidation, separated by commas
Const strConcat As String = "B"     'columns that need consolidating, separated by commas
Const strSep As String = ", "     'string that will separate the consolidated values
'*************END PARAMETERS*******************

application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")

lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

For i = lastRow To 2 Step -1 'loop from last Row to one

    For j = 0 To UBound(colMatch)
        If Cells(i, colMatch(j)) <> Cells(i - 1, colMatch(j)) Then GoTo nxti
    Next

    For j = 0 To UBound(colConcat)
        if len(Cells(i - 1, colConcat(j)))>0 then _
            Cells(i - 1, colConcat(j)) = Cells(i - 1, colConcat(j)) & strSep & Cells(i, colConcat(j))
    Next

    Rows(i).Delete

nxti:
Next

application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

Upvotes: 1

nubasic
nubasic

Reputation: 39

The following VBA code should work for what you are trying to do. It assumes that your email addresses are in the range A2:A50000, so you can change this to fit your needs. If you are not too familiar with VBA, under the Developer Tab in Excel 2011 Mac, there should be an icon called Visual Basic Editor. Open VB and CMD+Click on the window pane and insert a new module. Then paste in the following code:

Sub combineData()
Dim xCell As Range, emailRange As Range
Dim tempRow(0 To 3) As Variant, allData() As Variant
Dim recordCnt As Integer

Set emailRange = Range("A2:A11")
recordCnt = -1

'LOOP THROUGH EACH CELL AND ADD THE DATE TO AN ARRAY
For Each xCell In emailRange
    'IF THE CELL IS EQUAL TO THE ONE ABOVE IT,
    'ADD THE PRODUCT NUMBER SEPARATED WITH A COMMA
    If xCell = xCell.Offset(-1, 0) Then
        tempRow(1) = tempRow(1) & ", " & xCell.Offset(0, 1).Value
        allData(recordCnt) = tempRow
    Else
        recordCnt = recordCnt + 1
        If recordCnt = 0 Then
            ReDim allData(0 To recordCnt)
        Else
            ReDim Preserve allData(0 To recordCnt)
        End If
        tempRow(0) = xCell.Value
        tempRow(1) = xCell.Offset(0, 1).Value
        tempRow(2) = xCell.Offset(0, 2).Value
        tempRow(3) = xCell.Offset(0, 3).Value
        allData(recordCnt) = tempRow
    End If
Next xCell

'CREATE A NEW WORKSHEET AND DUMP IN THE CONDENSED DATA
Dim newWs As Worksheet, i As Integer, n As Integer

Set newWs = ThisWorkbook.Worksheets.Add

For i = 0 To recordCnt
    For n = 0 To 3
        newWs.Range("A2").Offset(i, n) = allData(i)(n)
    Next n
Next i

End Sub

Then close VB, and click the "Macros" button under the Developer tab. Then run combineData. That should give you the result you're looking for. Let me know if you have any trouble!

Upvotes: 0

Related Questions