Needing a macro for a count/correlation matrix

[maroonwhite2011]

I will start out by saying I am not a programmer. I am a researcher needing to create a 6000x6000 count matrix that would be set up similar to a correlation matrix. The current project I am working on is looking at the professional associations between roughly 6000 researchers that have published roughly 2000 articles in my field. The ultimate goal is a network analysis study, but in order to progress I have to build a matrix that is readable in that software.

Each article has its own row in Excel. Starting with column B, each author associated with that article is listed out--one per cell. The macro would need to be able to read each row, left to right, and record (in a separate sheet) the frequency count of each time one researcher has worked with another. Each article has a variable amount of authors, and therefore will need to recognize the need to jump to the next row when it reaches in empty cell. The macro would also need to update the numbers each time a particular association shows up again. Is there a relatively simple way for this do be done, or where I might be able to find instructions on writing this type of macro? Again, I have no experience and I have roughly one month to complete this project for a conference. Any assistance will be greatly appreciated.

[walruseggman]

This was kinda fun to write. I only tested it on 5 rows with 2-6 names per row, but it should work fine. Assuming the names are formatted the same way every time the appear. What I mean is that "John Smith" and "Smith, John" would be seen as two different people.

Sub maroonwhite()

Set ws1 = Worksheets("Sheet1") ' worksheet with article list
Set ws2 = Worksheets("Sheet2") ' output worksheet

LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
OpenRow = 1

For i = 1 To LastRow
    LastCol = ws1.Cells(i, Columns.Count).End(xlToLeft).Column
    
    For j = 2 To LastCol - 1
        For k = j + 1 To LastCol
            Name1 = ws1.Cells(i, j).Value
            Name2 = ws1.Cells(i, k).Value
            
            Set c = ws2.Range("A:A").Find(Name1 & " & " & Name2)
                If Not c Is Nothing Then
                    c.Offset(0, 1).Value = c.Offset(0, 1).Value + 1
                Else
                    Set c = ws2.Range("A:A").Find(Name2 & " & " & Name1)
                    If Not c Is Nothing Then
                        c.Offset(0, 1).Value = c.Offset(0, 1).Value + 1
                    Else
                        ws2.Cells(OpenRow, 1).Value = Name1 & " & " & Name2
                        ws2.Cells(OpenRow, 2).Value = 1
                        OpenRow = OpenRow + 1
                    End If
                End If
        Next
    Next
Next

End Sub