Merge multiple rows based on duplicate cell

[GingerThomas]

I have a list of movies that have won or been nominated for one or more awards in various years. I want all award information for one title to appear on one line. Is there a way to do that? Each award has three columns of information: award name, whether the film was nominated or won, and year of award.
Thanks for any suggestions!

 

[DanteAmor]

Hi and welcome to MrExcel.

Do you want the list of all titles or just one?
You can put how you want the result of 2 titles, for example "Best of enemies" and "Minding the gap"

It is recommended that you use XL2BB tool to put examples here, since we cannot copy them from an image.

 

[GingerThomas]

Hi, thanks for replying! Here's the XL2BB information, which hopefully you can use. On the left side is the list of films, one line per film per award. On the right side is how I want the data to appear: one line per film with an "X" in the column for any award it received. Thanks!

Awards.xlsx
	F
13
Solution

 

[GingerThomas]

Might have done previous XL2BB wrong. Here it is when I've selected the range of information:

Awards.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Film Title	Academy Awards	IDA	Emmy		Film Title	Academy Awards	IDA	Emmy
2	(T)ERROR		IDA			(T)ERROR		X	X
3	(T)ERROR			Emmy		Abacus: Small Enough to Jail	X		X
4	Abacus: Small Enough to Jail	Academy Awards				Always in Season		X
5	Abacus: Small Enough to Jail			Emmy		Armed With Faith			X
6	Always in Season		IDA			Best of Enemies	X	X	X
7	Armed With Faith			Emmy		Dawnland			X
8	Best of Enemies	Academy Awards				Forever Pure			X
9	Best of Enemies		IDA			Hale County This Morning, This Evening	X	X
10	Best of Enemies			Emmy
11	Dawnland			Emmy
12	Forever Pure			Emmy
13	Hale County This Morning, This Evening	Academy Awards
14	Hale County This Morning, This Evening		IDA
15
Solution Mr. Excel

 

[DanteAmor]

This macro works according to the structure you put in post # 4.

Sub Merge_multiple_rows()
  Dim a As Variant, b As Variant
  Dim dic As Object, i As Long, j As Long
  a = Range("A2:D" & Range("A" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a), 1 To 4)
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      j = j + 1
      dic(a(i, 1)) = j
      b(j, 1) = a(i, 1)
    Else
      j = dic(a(i, 1))
    End If
    If a(i, 2) <> "" Then b(j, 2) = "X"
    If a(i, 3) <> "" Then b(j, 3) = "X"
    If a(i, 4) <> "" Then b(j, 4) = "X"
  Next
  Range("F2").Resize(j, 4).Value = b
End Sub

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Merge_multiple_rows) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[GingerThomas]

It worked!! Thank you so much for this! I'm still new to all of this, and I'm just floored (in the best way) that people are willing to spend time answering these questions.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[GingerThomas]

Hello! Can I ask you another question? If I were to another column of awards (in truth I need to add about 7, but I'm just trying to figure out the language of the macro), what changes in the macro? I tried changing this line
ReDim b(1 To UBound(a), 1 To 4)

to be
ReDim b(1 To UBound(a), 1 To 5)

and then at the bottom I added
If a(i, 5) <> "" Then b(j, 5) = "X"

but I got an error at that last row (and changing just the ReDim row doesn't seem to do anything).

I really appreciate any help. I started taking a class on VBA but realized there's so much I don't know that I'm light years from understanding this macro.

Thanks,
Ginnie

 

[DanteAmor]

If I were to another column of awards

Now I made it simpler, just update the final column of awards and the output cell.

Sub Merge_multiple_rows()
  Dim a As Variant, b As Variant
  Dim dic As Object, i As Long, j As Long, k As Long
  
  'Columns of the range
  a = Range("A2:F" & Range("A" & Rows.Count).End(3).Row).Value2
  '
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      j = j + 1
      dic(a(i, 1)) = j
      b(j, 1) = a(i, 1)
    Else
      j = dic(a(i, 1))
    End If
    For k = 2 To UBound(a, 2)
      If a(i, k) <> "" Then b(j, k) = "X"
    Next
  Next
  '
  'output cell 
  Range("Z2").Resize(j, UBound(b, 2)).Value = b
End Sub