Dim dataIn(16, 16) As String Dim dataNums(16, 16) As Integer Dim groupCount As Integer Dim groups(20, 20) As String Dim numberPerGroup(20) As Integer Dim confusionMatrix(20, 20) As String Dim unorderedTalkers(20) As String Sub process() '**Run:reset before running macro to avoid indexing error '**Doesn't work quite right with elbow to the left '**read in data For I = 1 To 16 For J = 1 To 16 dataIn(I, J) = ActiveSheet.Cells(I, J + 1) Next J Next I '**assign group numbers groupCount = 0 For I = 1 To 16 For J = 1 To 16 If dataIn(I, J) = "" Then '**if nothing there, group 0 dataNums(I, J) = 0 Else If dataNums(I - 1, J) = 0 Then '**if previous is 0, new group groupCount = groupCount + 1 dataNums(I, J) = groupCount Else '**if previous is in group, current gets same number dataNums(I, J) = dataNums(I - 1, J) End If If dataNums(I, J) = dataNums(I, J - 1) Then '**if above is same group, good Else '**if above is in group, but not the same group, change all current groups to match If dataNums(I, J - 1) = 0 Then '**do nothing if above is 0 Else '**change all in current group to group matching above For K = 1 To 16 For L = 1 To 16 If dataNums(K, L) = groupCount Then dataNums(K, L) = dataNums(I, J - 1) End If Next L Next K groupCount = groupCount - 1 End If End If End If Next J Next I '**make groups matrix currentTalker = 1 For K = 1 To 20 For I = 1 To 16 For J = 1 To 16 If dataNums(I, J) = K Then groups(K, currentTalker) = dataIn(I, J) currentTalker = currentTalker + 1 End If Next J Next I numberPerGroup(K) = currentTalker - 1 currentTalker = 1 Next '**make confusion matrix IndexC = 1 IndexR = 1 IndexC2 = 1 For K = 1 To 20 For J = 1 To numberPerGroup(K) For I = 1 To numberPerGroup(K) If I > J Then confusionMatrix(IndexC, IndexR) = 1 Else confusionMatrix(IndexC, IndexR) = 0 End If IndexC = IndexC + 1 Next I IndexR = IndexR + 1 IndexC = IndexC2 Next J IndexC2 = IndexC2 + numberPerGroup(K) IndexC = IndexC2 Next K '**unordered talker list Index = 1 For K = 1 To 20 For J = 1 To 20 If groups(K, J) = "" Then Index = Index - 1 Else unorderedTalkers(Index) = groups(K, J) End If Index = Index + 1 Next J Next K '**output group number assignment matrix For I = 1 To 16 For J = 1 To 16 ActiveSheet.Cells(I + 17, J + 1).Value = dataNums(I, J) Next J Next I '**output groups by number For I = 1 To 20 For K = 1 To 20 ActiveSheet.Cells(I + 34, K + 1) = groups(I, K) Next K Next I '**output unsorted confusion matrix For J = 1 To 20 ActiveSheet.Cells(J + 56, 1) = unorderedTalkers(J) Next J For I = 1 To 20 ActiveSheet.Cells(56, I + 1) = unorderedTalkers(I) For J = 1 To 20 ActiveSheet.Cells(I + 56, J + 1) = confusionMatrix(I, J) Next J Next I End Sub