VBA Help for an Excel Matrix

[Burak]

Hello Everyone,

I've just joined this group and I have a simple question for you that I swamped while coding it

First of all, I have a dummy TEST and PARAMETER table in my first sheet. Which is like;

	Parameter 1	Parameter 2	Parameter 3	Parameter 4	Parameter 5	Parameter 6	Parameter 7	Parameter 8	Parameter 9	Parameter 10
Test 1	X			X			X			X
Test 2	X	X	X			X	X	X	X	X
Test 3	X		X	X	X	X	X	X		X
Test 4		X			X	X	X			X
Test 5			X				X			X
Test 6	X				X	X	X	X	X
Test 7		X	X	X		X	X	X		X
Test 8					X	X	X	X
Test 9				X		X	X
Test 10		X					X		X	X

<tbody>
</tbody>

What I want to do with this table is; user will select the parameter(s) and another sheet will display related tests for each parameter.

For example, user selects parameter 1 and parameter 3. Then, I want to create a report sheet like;

Parameter 1

Test 1

Test 2

Test 3

Test 6

Parameter 3

Test 2

Test 3

Test 5

Test 7

<tbody>
</tbody>

I really couldn't figure out the VBA code configuration for it. I believe, there is a simple way, but I'm trying.
Therefore, I wonder your thoughts and I'd be glad if you help.

Thank you.

 

[lrobbo314]

I created a UserForm. On the UserForm I added 1 Button. For the UserForm_Activate code I have

Private Sub UserForm_Activate()
Dim r As Range
Dim ar()
Set r = Range("B1", Range("B1").End(xlToRight))
ar = r.Value
For i = 1 To UBound(ar, 2)
    Me.ListBox1.AddItem ar(1, i)
Next i
Me.ListBox1.MultiSelect = fmMultiSelectExtended
End Sub

Then, the code for the Button_Click Event I have

Private Sub CommandButton1_Click()
Dim SD As New Dictionary
Dim Matrix()
Dim ws As Worksheet
Dim Res()
Dim Cnt As Long
Dim r As Range
Cnt = 0
Set ws = Sheets.Add(after:=Sheets(ActiveWorkbook.Sheets.Count))
ws.Name = "Results"
Matrix = Sheets("Sheet1").Range("A1").CurrentRegion.Value
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        SD.Add Me.ListBox1.List(i), Me.ListBox1.List(i)
    End If
Next i
For i = 2 To UBound(Matrix, 2)
    If SD.Exists(Matrix(1, i)) Then
        Cnt = Cnt + 1
        ReDim Preserve Res(1 To Cnt)
        Res(Cnt) = Matrix(1, i)
        For j = 2 To UBound(Matrix)
            If Matrix(i, j) = "X" Then
                Cnt = Cnt + 1
                ReDim Preserve Res(1 To Cnt)
                Res(Cnt) = Matrix(j + 1, 1)
            End If
        Next j
    End If
Next i
Set r = ws.Range("A1").Resize(UBound(Res), 1)
r.Value = Application.Transpose(Res())

End Sub

When you open the userform, the user will select which Parameters they want. Then they click the button. The code will create a new sheet called "Results" and output the information the way you said in your original post.

This code uses a Dictionary, so you will have to add a reference to Microsoft Scripting Runtime. Tools-->References-->Microsoft Scripting Runtime.

Let me know if you have any questions.

 

[lrobbo314]

I made a small correction to the code above.

Private Sub CommandButton1_Click()
Dim SD As New Dictionary
Dim Matrix()
Dim ws As Worksheet
Dim Res()
Dim Cnt As Long
Dim r As Range
Cnt = 0
Set ws = Sheets.Add(after:=Sheets(ActiveWorkbook.Sheets.Count))
ws.Name = "Results"
Matrix = Sheets("Sheet1").Range("A1").CurrentRegion.Value
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        SD.Add Me.ListBox1.List(i), Me.ListBox1.List(i)
    End If
Next i
For i = 2 To UBound(Matrix, 2)
    If SD.Exists(Matrix(1, i)) Then
        Cnt = Cnt + 1
        ReDim Preserve Res(1 To Cnt)
        Res(Cnt) = Matrix(1, i)
        For j = 2 To UBound(Matrix)
            If Matrix(j, i) = "X" Then
                Cnt = Cnt + 1
                ReDim Preserve Res(1 To Cnt)
                Res(Cnt) = Matrix(j, 1)
            End If
        Next j
    End If
Next i
Set r = ws.Range("A1").Resize(UBound(Res), 1)
r.Value = Application.Transpose(Res())
Unload Me
End Sub
Private Sub UserForm_Activate()
Dim r As Range
Dim ar()
Set r = Range("B1", Range("B1").End(xlToRight))
ar = r.Value
For i = 1 To UBound(ar, 2)
    Me.ListBox1.AddItem ar(1, i)
Next i

Me.ListBox1.MultiSelect = fmMultiSelectExtended
End Sub
Sub RunIt()
UserForm1.Show False
End Sub

 

[Burak]

Dear @lrobbo314 ,

Thanks for your help and diligent work. However, I got error on line "Dim SD As New Dictionary" and it says "User-defined type not defined" I couldn't understand what causes it.

On the other hand, can't this be done w/o using userform? Do you have any idea?

Thank you.

 

[lrobbo314]

Did you add the reference to Microsoft Scripting Runtime?

I did come up with a formula solution.

I pasted your data in range A2:K12.
To simulate the user 'selecting' a parameter, I add a '1' to the cell above the parameter in row 1. So to select parameter 1 , the user would put a 1 in B1. Parameter 5 would be F1.

Then, in M2 I put this formula.

=IFERROR(INDEX($B$2:$K$2,MATCH(SMALL(IF(TRANSPOSE($B$1:$K$1=1),ROW(INDIRECT("1:10"))),COLUMN(A1)),TRANSPOSE($B$1:$K$1=1)*ROW(INDIRECT("1:10")),0)),"")

Hit Ctrl+Shift+Enter because it is an array formula. Copy it across to V2.

Then in M3 I put this formula.

=IFERROR(INDEX($A$3:$A$12,MATCH(SMALL(IF(INDIRECT(ADDRESS(3,MATCH(M$2,$B$2:$K$2,0)+1)&":"&ADDRESS(12,MATCH(M$2,$B$2:$K$2,0)+1))="X",ROW(INDIRECT("1:10"))),ROW($A1)),(INDIRECT(ADDRESS(3,MATCH(M$2,$B$2:$K$2,0)+1)&":"&ADDRESS(12,MATCH(M$2,$B$2:$K$2,0)+1))="X")*(ROW(INDIRECT("1:10"))),0)),"")

Ctrl+Shift+Enter again. Copy across to V3 then copy from M3:V3 down to M12:V12.

Not sure if this formula approach is better for you.

If you're not using a userform then how would you like to capture which parameters the user wants to select?

 

[Burak]

Dear @lrobbo314

Your formula did work magically. I had difficulties to understand the logic of formula, but I will dig it out later on.
I created listbox in sheet which helps me putting '1's for selected parameters.

Thank you so much again, have a good day!

 

[lrobbo314]

Happy to help. Thanks for the feedback.

 

[lrobbo314]

I was able to pretty significantly reduce the size of one of the formulas. This is the formula for the data, not the headers.

=IFERROR(INDEX($A$3:$A$12,SMALL(IF(OFFSET($A$1,2,MATCH(M$2,$B$2:$K$2,0),10,1)="X",ROW(INDIRECT("1:10"))),ROW($A1))),"")