I have an Excel database and I'm trying avoid doing some manual combining of duplicate data. I've got a bunch of listings that are essentially the same aside from the tags column. What I'd like to have it do is combine these 5 listings into 1 listing, making the categories a comma separated list in a single cell.
Turn this
into this
Is there any way of achieving this? My document has a couple thousand listings, so I'm obviously trying to avoid the manual edit route. I'm an Excel novice, so any hand holding or tutorials you could point me to would be appreciated.
This can also be done using formulas. For my example to work, the data would need to be sorted by the first column and there would need to be a header row.
You would need two more columns (C & D). First, add a formula that essentially says to concatenate the data in column B if data in column A is the same as the row above it, otherwise reset the concatenation. The next column would contain a formula to identify the final concatenations so you can sort later.
This is how I would do it with listings and categories in columns A & B (again, the data would need to be sorted by column A and there would need to be a header row):
Here's the results. Now I would copy the entire range and paste values into another sheet. The rows with zero for column D is what I'd want to use. Sorting by column D would float them to the top.
This will (should) generate a new sheet from your source sheet with the duplicates concatenated.
To use the following code you need to add it to a new module in the VBA Editor
A Shortcut to open the VBA Editor is Alt+F11
(for Windows) and Alt+Fn+F11
(for Mac)
Once the Editor is open add a new module by selecting it from the "insert" menu in the main menu bar. It should automatically open the module ready to accept code, If not you need to select it (will be named "ModuleN" where N is the next available number) from the project explorer.
I'm not sure if the "Scripting.Dictionary" is available in osx, but it cant hurt to try.
Option Explicit
Sub Main()
Dim Source As Worksheet: Set Source = ThisWorkbook.Worksheets("Sheet1")
Dim Destination As Worksheet: Set Destination = ThisWorkbook.Worksheets("Sheet2")
Dim Records As Object: Set Records = CreateObject("Scripting.Dictionary")
Dim Data As Variant
Dim Index As Long
Dim Row As Integer: Row = 1
Data = Source.Range("A1", "B" & Source.Rows(Source.UsedRange.Rows.Count).Row).Value2
For Index = LBound(Data, 1) To UBound(Data, 1)
If Records.Exists(Data(Index, 1)) Then
Destination.Cells(Records(Data(Index, 1)), 2).Value2 = Destination.Cells(Records(Data(Index, 1)), 2).Value2 & ", " & Data(Index, 2)
Else
Records.Add Data(Index, 1), Row
Destination.Cells(Row, 1).Value2 = Data(Index, 1)
Destination.Cells(Row, 2).Value2 = Data(Index, 2)
Row = Row + 1
End If
Next Index
Set Records = Nothing
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With