How to merge information from duplicates to one line

[otbas]

1. I have exported contact info from another platform to an Excel sheet.

2. I then have to copy/paste to the bottom of this Excel sheet the same contacts but sorted by (1) location and state; and then do another copy/pase for same contacts but sorted by (2) Industry.

3. This creates a very large list (tens of thousands of contacts) because I have each name duplicated 3 times.

4. I sort the list, so that same names are grouped together. However, now I have the rows with the following information for same contact:

1st row: ABCDEFG, Company, Email, Department
2nd row: ABCDEFG, Location, St
3rd row: ABCDEFG, Industry

I need a way combined the 3 same names to 1 row, moving the info on row 2 and row 3 to the appropriate column on row 1.

And I need to do this for the whole list.

So, whereas my original exported list might have 10,000 contacts, after I have copy/pasted the sorted groups over, that 10,000 becomes a list of 30,000. Once the information from rows 2 and 3 (and each subsequent 2 rows for all the other names) I can then delete the duplicate names, bringing the list back to 10,000, but this time the 10,000 will have all the required information.

Unfortunately, the platform I am exporting from does not export the list with all the information, just a basic 6 columns of information; you have to go back to the program and do a sort by location/state and then by industry, thereby producing the duplication of the original contacts.


Anyone have any ideas how to do this, it would be much appreciated, as right now it's taking forever to do the copy/paste/combining, and I have to do this for over and over, as new contacts are added and new lists are exported.

Thanks again. Very much appreciated!

Janice

[Bob Phillips]

Public Sub ProcessData()Dim Lastrow As Long
Dim Lastcol As Long
Dim i As Long


    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = Lastrow To 3 Step -1
        
            If .Cells(i, "A").Value2 = .Cells(i - 1, "A").Value2 Then
            
                Lastcol = .Cells(i - 1, .Columns.Count).End(xlToLeft).Column
                .Cells(i, "B").Resize(, 100).Copy .Cells(i - 1, Lastcol + 1)
                .Rows(i).Delete
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[otbas]

Thanks Bob for the code. However, even though I use Excel a lot, I have never gotten into how to use "code" to perform functions. So, my next question, is, with the Excel sheet open, how do I get the code you set up below to work?

Public Sub ProcessData()Dim Lastrow As Long
Dim Lastcol As Long
Dim i As Long


    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = Lastrow To 3 Step -1
        
            If .Cells(i, "A").Value2 = .Cells(i - 1, "A").Value2 Then
            
                Lastcol = .Cells(i - 1, .Columns.Count).End(xlToLeft).Column
                .Cells(i, "B").Resize(, 100).Copy .Cells(i - 1, Lastcol + 1)
                .Rows(i).Delete
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[Bob Phillips]

Goto View>Macros>View Macros and select the macro from the list and hit Run.