Help: Table with multiple values to List

[Xerno]

Hi everyone,

Im trying to figure out a way to make a Table into a list.

Example:

	Peter	Anders	Mikael	John
Criteria1	1		1
Criteria2		1		1
Criteria3	1	1	1
Criteria4		1		1

<tbody>
</tbody>

What I know want to do is the following if the cell has "1" with a formula if possible:

Peter	Criteria1
Peter	Criteria3
Anders	Criteria2
Anders	Criteria3
Anders	Criteria4
Mikael	Criteria1
Mikael	Criteria3
John	Criteria2
John	Criteria4

<tbody>
</tbody>

I was first thinking with a Index Match but I cant figure this out.

Can anyone help me?

Thanks in advance

 

[Takae]

Sheet1 has data, results will be in Sheet2.

Sub test()
Dim cnt As Long, i As Long, j As Long, LR As Long
Dim rng As Range, c
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
With ws1
    For i = 2 To .cells(1, Columns.count).End(xlToLeft).column
        .Range("A1").AutoFilter field:=i, Criteria1:=1
        If WorksheetFunction.Subtotal(3, .Range("A:A")) > 1 Then
            For Each c In .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
                If c <> "" Then
                    With ws2
                        LR = .cells(Rows.count, 1).End(xlUp).row + 1
                        .cells(LR, 2).Value = c.value
                        .cells(LR, 1).Value = ws1.cells(1, i).Value
                    End With
                End If
            Next
        End If
        .Range("A1").AutoFilter
    Next
End With
End Sub

 

[Xerno]

Thank you so much, works like a charm

Arigatō sensei