Concatenating information from columns next to repeated rows

MacroMoron

New Member
Joined
Jan 27, 2014
Messages
4
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:


image.png


- 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.

image.png


- Above, data is concatenated into column C.

image.png


- 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.
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

skorpionkz

Well-known Member
Joined
Oct 1, 2013
Messages
1,168
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.

Code:
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

New Member
Joined
Jan 27, 2014
Messages
4
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.

Rich (BB code):
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.
 

MacroMoron

New Member
Joined
Jan 27, 2014
Messages
4

ADVERTISEMENT

Sent you a PM, thanks.
 

skorpionkz

Well-known Member
Joined
Oct 1, 2013
Messages
1,168
Code is updated:

Code:
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

New Member
Joined
Jan 27, 2014
Messages
4
Code is updated:

Code:
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,122,370
Messages
5,595,774
Members
414,018
Latest member
quang118

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top