Concatenating information from columns next to repeated rows

[MacroMoron]

Hello there,

I'm looking to modify some existing code for a macro that concatenates a range of data. Essentially, I'm looking to do the following:

1. Search through data in column A (all strings) and find an instance where a row is a repeat of the row above it.
2. In the repeated row (let's say A2 contains "Bob" and A3 contains "Bob") concatenate the information from another column in the same row (e.g. column C3) into the row of the same column above it (ergo, info in C3 is concatenated into C2).
3. A separator/divisor needs to be included whilst concatenating.
4. With the data from the repeated row concatenated, this row must now be deleted.

The above may be very unclear so I'll explain this with some images:

- Highlighted rows signify where repeated data occurs in column A. Only the first instance of the data highlighted in green must remain. The rows in red need the data from column C concatenated into column C of the green row. When this is complete, they need to be deleted.

- Above, data is concatenated into column C.

- Above, after concatenating the data, the repeated rows are deleted.


I hope I've made this clear but let me know if I need to clarify anything. Any help on this issue would be greatly appreciated.

 

[skorpionkz]

Try below code:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub RemDup()
Dim irow As Long, DupRow As Long
Dim iNum As String


irow = 2
iNum = Empty
Do Until Cells(irow, 1) = Empty
    If Cells(irow, 1) = Cells(irow + 1, 1) Then
        If DupRow = Empty Then DupRow = irow
    iNum = iNum & Cells(irow, 3) & " | "
    ElseIf Cells(irow, 1) = Cells(irow - 1, 1) Then
    iNum = iNum & Cells(irow, 3)
    Cells(DupRow, 3) = iNum
    Range(Rows(DupRow + 1), Rows(irow)).Delete shift:=xlUp
    DupRow = Empty
    End If
    
irow = irow + 1
Loop
End Sub

 

[MacroMoron]

Try below code:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub RemDup()
Dim irow As Long, DupRow As Long
Dim iNum As String


irow = 2
iNum = Empty
Do Until Cells(irow, 1) = Empty
    If Cells(irow, 1) = Cells(irow + 1, 1) Then
        If DupRow = Empty Then DupRow = irow
    iNum = iNum & Cells(irow, 3) & " | "
    ElseIf Cells(irow, 1) = Cells(irow - 1, 1) Then
    iNum = iNum & Cells(irow, 3)
    Cells(DupRow, 3) = iNum
    Range(Rows(DupRow + 1), Rows(irow)).Delete shift:=xlUp
    DupRow = Empty
    End If
    
irow = irow + 1
Loop
End Sub

Thanks for helping me out,

After running for about 1/3 a second the script gives me a "Runtime Error 1004". When I click debug, it highlights the line above in red. Any ideas on why it's giving this error? It does appear to function as intended but only for a very brief period.

 

[skorpionkz]

I have no errors. Can you upload sample file?

 

[MacroMoron]

Sent you a PM, thanks.

 

[skorpionkz]

Code is updated:

Sub RemDup()
Dim irow As Long, DupRow As Long
Dim iNum As String

irow = 2
iNum = Empty
Do Until Cells(irow, 1) = Empty
    If Cells(irow, 1) = Cells(irow + 1, 1) Then
        If DupRow = Empty Then DupRow = irow
    iNum = iNum & Cells(irow, 3) & " | "
    ElseIf Cells(irow, 1) = Cells(irow - 1, 1) Then
    iNum = iNum & Cells(irow, 3)
    Cells(DupRow, 3) = iNum
    Range(Rows(DupRow + 1), Rows(irow)).Delete shift:=xlUp
    irow = DupRow
    DupRow = Empty
    iNum = Empty
    End If
irow = irow + 1
Loop

End Sub

 

[MacroMoron]

Code is updated:

Sub RemDup()
Dim irow As Long, DupRow As Long
Dim iNum As String

irow = 2
iNum = Empty
Do Until Cells(irow, 1) = Empty
    If Cells(irow, 1) = Cells(irow + 1, 1) Then
        If DupRow = Empty Then DupRow = irow
    iNum = iNum & Cells(irow, 3) & " | "
    ElseIf Cells(irow, 1) = Cells(irow - 1, 1) Then
    iNum = iNum & Cells(irow, 3)
    Cells(DupRow, 3) = iNum
    Range(Rows(DupRow + 1), Rows(irow)).Delete shift:=xlUp
    irow = DupRow
    DupRow = Empty
    iNum = Empty
    End If
irow = irow + 1
Loop

End Sub

Thanks skorpionkz that works great. Cheers!

 

[skorpionkz]

Glad I was able to help