Need Help: Creating a Matrix

[dankenny]

Hi,

I have a dataset with the following structure.


ColumnA------>ColumnB------>ColumnC------>ColumnD
ClassA ------>OtherStud------>WorkWith------>PlayWith

AA ------> DD ------> 1 ----------> 0
AA ----------> EE ------> 0 ----------> 1
AA ----------> BB ------> 1 ----------> 1
BB ----------> FF ------> 1 ----------> 0
BB ----------> GG ------> 1 ----------> 1
BB ----------> KK ------> 0 ----------> 1
CC ----------> AA ------> 1 ----------> 1
CC ----------> BB ------> 1 ----------> 1


ColumnA refers to students in ClassroomA, and Column B refers to "Other Students" in the school who could act as work and/or playmates. Note, ColumnB could also include some of the same students in ClassroomA who work or play with each other (For example, Students: AA and BB).

If a Student in Classroom A works with a student in ClassroomB, ColumnC takes the value of 1, and 0(zero) if otherwise

If a student in Classroom A plays with a student in ClassroomB, ColumnD takes the value of 1, and 0 (zero), if otherwise

So, looking at ColumnA, we find that there are three students: AA, BB and CC.
Student_AA for instance interacts with three students <DD, EE, BB> but only works with DD and BB. Similarly, Student_CC interacts with two students <AA, and BB> and works and plays with each of them.

Now, I am interested in constructing 2 separate matrices indicating which students in ClassroomA (1) Work and (2) Play with each other. This means that student_AA for instance works with student_BB, who is in his/her classroom, hence the cell in their matrix will have a "1". Again, Student_CC in ClassroomA works with and plays with 2 other members of his/her own class<ie, AA and BB>. So CC would have two "1s" in the matrix.

The resulting matrix for the "Works With" relation (ColumnC) among the 3 students in ClassroomA would look like this.

AA BB CC
AA 0 1 0
BB 0 0 0
CC 1 1 0

This matrix is the output I am interested in. I would need to produce this matrix for the relation specified in columnC and ColumnD.

I would certainly appreciate some ideas to help me produce this.


Thanks in advance for your assistance.

Sincerely, DK

 

[jindon]

Ah

Do you have sheet named Sheet2?

If not, please add new sheet and name the sheet as Sheet2
then run the code activating the sheet with the data.

 

[dankenny]

Ok....now it produces:

Runtime error 1004. Application-defined or object-defined error.

Thanks for the continuing efforts.

Rgds, DK

 

[jindon]

oopps

Can you change teh 2nd last line that is

Range("a" & Rows.Count).End(xlDown).Offset(2).Resize(.....

to

Range("a1").End(xlDown).Offset(2).Resize(.....

I will edit the original code...

 

[dankenny]

Thanks, it did produce a matrix.

However, the row elements are not equal to the column elements.

For example, the rows have AA, BB, CC. But the columns have more than these three individuals. I want to be able to produce a square-matrix of AA, BB, CC (in rows) by AA, BB, CC (in columns).

Thanks, DK

 

[jindon]

OK then

do you need the row/column elements are unique value from col.A and B or just from col.A of the raw data?


I took row elements from co.A and column from col.B (unique values)

 

[dankenny]

The row and column elements should be those members of colA that also appear in colB.

So, lets assume colA has members AA, BB, CC.

If memberAA then talks to people in colB, and these people include BB, and CC

Then, rows and columns will be:

AA BB CC
AA 0 1 1
BB
CC

Thanks you so much for the assistance.

rgds, DK

 

[jindon]

try this one

Sub test()
Dim a, i As Long, ii As Integer, iii As Integer, b(), dic As Object
Dim x, flg As Boolean
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbtextcompare
a = Range("a1").CurrentRegion.Resize(,3).Value
For i = 1 To UBound(a,1)
     If Not dic.exists(a(i,1)) Then dic.add a(i,1), Nothing
Next
ReDim b(1 To dic.count + 1, 1 To dic.count + 1)
x = dic.keys
For i = 0 To UBound(x)
     b(i + 2,1) = x(i)
     b(1,i + 2) = x(i)
Next
For i = 1 To UBound(a,1)
     For ii = 2 To UBound(b,1)
          If b(ii,1) = a(i,1) And dic.exists(a(i,2)) Then
               For iii = 2 To UBound(b,2)
                    If b(1,iii) = a(i,2) Then
                         b(ii,iii) = b(ii,iii) + 1
                         flg = True : Exit For
                    End If
               Next
          End If
          If flg Then Exit For
     Next
     flg = False
Next
Range("e1").Resize(UBound(b,1), UBound(b,2)).Value = b
Set dic = Nothing
End Sub