Table summary issue (VBA or formula)

[Dani_LobP]

Hi all,

I am struggling to find a smart and efficient way where I can make a list out of a huge table.
Thought there would be someone here that could help me find a way to build a macro or some condition formula in order to obtain the result i am after.
Its heavy manual work but somehow i want to believe it can be automated somehow.

I have a list of names (in rows) and a list of items (in columns), but not all names necessary need to be in all columns, should be at least 1, but can also have none.... so I have many empty cells lets say.
In the end what I want to achieve, is to have a summary list of which column item is ticked for each name.. or which names appear on each column.
Example:

Name	Opt1	Opt2	Opt3	Opt4	Opt5	OptN
Alfa	Yes			Yes
Beta			Yes
Charlie		Yes
Delta				Yes	Yes
Echo			Yes
NameN						Yes

Thing is that I actually have 100-150 names (rows) and 288 options/items (columns) - that's why the N.

and below how id like to have it:

Ideally option 1 i believe is the best one since ill have it easier to group and work with it.

Alfa	Opt1
Alfa	Opt4
Beta	Opt3
Charlie	Opt2
Delta	Opt4
Delta	Opt5
Echo	Opt3
NameN	OptN

but Other option i thought to try is maybe to have them as below:

Opt1	Alfa
Opt2	Charlie
Opt3	Beta	Echo
Opt4	Alfa	Delta
Opt5	Delta
OptN	NameN

Not sure what would be easier to build to be honest.

I have the feeling it can be an easy task to do, but somehow I'm having hard time to put it all together.

Thanks in advance!

Regards,
Dani

 

[Fluff]

How about

Sub DaniLobP()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 2)
   
   For r = 2 To UBound(Ary)
      For c = 2 To UBound(Ary, 2)
         If Ary(r, c) = "Yes" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(1, c)
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 2).Value = Nary
End Sub

change sheet names to suit.

 

[Dani_LobP]

How about

Sub DaniLobP()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 2)
  
   For r = 2 To UBound(Ary)
      For c = 2 To UBound(Ary, 2)
         If Ary(r, c) = "Yes" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(1, c)
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 2).Value = Nary
End Sub

change sheet names to suit.

nice, works great Fluff! exactly what i wanted.
Would it be to much asking if you can explain what does each line do so i can understand better this type of macro? looks like it can be reused in other examples i have and tailor it as it comes..
Once again thanks for your prompt help! :D

 

[Fluff]

Hope this helps

Sub DaniLobP()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2     'pulls the data from the sheet into an array
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 2)       'resizes the output array
   
   For r = 2 To UBound(Ary)                                    'starts to loop through the array row by row
      For c = 2 To UBound(Ary, 2)                              'starts to loop the the array column by column
         If Ary(r, c) = "Yes" Then
            nr = nr + 1                                        'increments the row in the output array by one
            Nary(nr, 1) = Ary(r, 1)                            'populates the output array with the name from column one
            Nary(nr, 2) = Ary(1, c)                            'populates the output array with the column header
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 2).Value = Nary     'dumps the output array to the sheet
End Sub

 

[Dani_LobP]

Hope this helps

Sub DaniLobP()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2     'pulls the data from the sheet into an array
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 2)       'resizes the output array
  
   For r = 2 To UBound(Ary)                                    'starts to loop through the array row by row
      For c = 2 To UBound(Ary, 2)                              'starts to loop the the array column by column
         If Ary(r, c) = "Yes" Then
            nr = nr + 1                                        'increments the row in the output array by one
            Nary(nr, 1) = Ary(r, 1)                            'populates the output array with the name from column one
            Nary(nr, 2) = Ary(1, c)                            'populates the output array with the column header
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 2).Value = Nary     'dumps the output array to the sheet
End Sub

Thanks a lot!

 

[Fluff]

You're welcome & thanks for the feedback.