Concatenate (Excel) rows based on common cell, including different columns

Question

I've been searching for a way to concatenate my Excel (or any other tool/software handling tables) rows based on common cells. As an example:

I have this tab-stop divided table. Each of the values is in a separate row:

angeb*    12      16      18    
zyste*        60      61        
zynisch*      12            
zyste*        60            
abstreit*     70            
anflunker*    70            
angeb*    70    

I want to concatenate the rows in a way that the result would be:

angeb*    12      16      18      70
zyste*        60      61        
zynisch*      12                    
abstreit*     70            
anflunker*    70

It does work by doing as proposed in this tutorial, but it only concatenates single cell values into another single cell. I also tried going the path basically proposed by this so question and finally leading me to VLOOKUP (description). But they all concatenate in cells.

Basically pretty simple, I need to merge cells with the same Column 1, but keep the columns, just concatenate beyond. The second row can then be deleted, once it is added to the first one. I tried adapting the above scripts, but I could not make it work in one step, just with then converting comma separated values into cells and copying them to new columns. I am not an expert with VBA, but this seems like a very simple functionality, I might as well be missing something. Any help is greatly appreciated.

Answer 1

I have written and color-coded each part of what I did, but here is the general method:

1. Sort all data A-Z
2. Use a CountIf statement to count how many times a particular data row shows up.
3. Assuming 3 columns of data, find MAX() of MaxRows, multiply (here, 3 columns x 2 Rows maximum observed = 6 data max).
4. Copy the labels, remove duplicates [Green] so you have a condensed table.
5. Use IndexMatch equations, coupled with IF and IFERROR statements to re-sort the data. Note the +1 for Columns P-Q)

Problem - you can still get a gap, but it's all in the same rows now!

Here's a quick Youtube video on how I did it. TSpinde Answer 1

Answer 2

I was a little confused by your question so I only concatenated names that were exactly the same.

So the way my code works is it makes an array of tags and when it runs into one that it already has it looks for the next empty slot in the original row. It then adds the value in and does this until it hits an empty cell in the new row. There's a bit of funny business with decreasing the lastrow value and changing the row it's on, but its necessary for it to move to the correct row of data in the next cycle.

This macro assumes that all possible data entries are side by side, for example there wont be a value in C2 and E2 if D2 is empty.

Sub macro()

Dim LastRow As Long
Dim LastCol As Long
Dim TagArray() As String
Dim count As Long
Dim i As Long
Dim j As Long
Dim PreExisting As Boolean
Dim Targetrow As Long

ReDim TagArray(1 To 1)
LastRow = Worksheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Worksheets(1).Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
TagArray(1) = Worksheets(1).Range("A1").Value

For i = 2 To LastRow
    PreExisting = False

    For j = 1 To UBound(TagArray)
        If Worksheets(1).Cells(i, 1) = TagArray(j) Then
            PreExisting = True
            Targetrow = j
            Exit For
        End If
    Next j

    If PreExisting Then
        For j = 2 To LastCol
            If Not IsEmpty(Worksheets(1).Cells(i, j)) Then
                For count = 1 To LastCol
                    If IsEmpty(Worksheets(1).Cells(Targetrow, count)) Then
                        Worksheets(1).Cells(Targetrow, count) = Worksheets(1).Cells(i, j)
                        Exit For
                    Else
                        If count = LastCol Then
                            LastCol = LastCol + 1
                            Worksheets(1).Cells(Targetrow, LastCol) = Worksheets(1).Cells(i, j).Value
                        End If
                    End If
                Next count
            Else
                Exit For
            End If
        Next j
        Worksheets(1).Rows(i).Delete
        LastRow = LastRow - 1
        i = i - 1
    Else
        ReDim Preserve TagArray(1 To UBound(TagArray) + 1)
        TagArray(UBound(TagArray)) = Worksheets(1).Cells(i, 1)
    End If

Next i

End Sub

Hopefully, you find this useful if you wanted to use it in VBA instead of worksheet functions.