7 thoughts on “Dynamic Matrix with ADO”

1. Great example to learn from. How come there’s a block of code that repeats under the “Loop through the clone” section?

2. Sean: The file letter goes in two spots. In the first block rRow goes with rs and rCol goes with rsFilter. In the second block, that’s switched.

3. DK: Assuming the results are symmetric…

   You never need to find the row and column a 2nd time. Define the matrix as having element (1,1) at the first grey cell and element (10,10) as the last grey cell. Then, if you have some value that goes in element (r,c), the same result will also be in element (c,r).

4. Tushar, you are right. They are symmetric. I fixed my code to reflect that.

   I probably would have used classes too but I just threw this together just because I like dictionaries. Not entirely elegant but I had fun throwing it together.

   Public Sub CreateMatrixDictionary()
      
       Dim i As Integer, j As Integer
       Dim saMatrix() As String, saHeader() As String, saFile() As String
       Dim sFile As String, sTaskDeveloper As String
       Dim rData As Range
       Dim vData As Variant
       Dim dicTask As Dictionary
      
       ‘Initialize variables
      Set dicTask = New Dictionary
          
       ‘Get sorted data
      Set rData = ActiveSheet.UsedRange
       Set rData = rData.Offset(1).Resize(rData.Rows.Count – 1)
       rData.Sort Key1:=rData.Range(“$B$1”), Order1:=xlAscending, Header:=xlNo, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
           DataOption1:=xlSortNormal
       vData = rData
       rData.Sort Key1:=rData.Range(“$C$1”), Order1:=xlAscending, Header:=xlNo, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
           DataOption1:=xlSortNormal
      
      
       ‘Organize data
      For i = 1 To UBound(vData)
           sTaskDeveloper = vData(i, 2) & “:” & vData(i, 1)
           sFile = vData(i, 3)
           If Not dicTask.Exists(sTaskDeveloper) Then
               ReDim saFile(0 To 0)
               saFile(0) = sFile
               dicTask.Add sTaskDeveloper, saFile
           Else
               If Not InArray(dicTask(sTaskDeveloper), sFile) Then
                   saFile = dicTask(sTaskDeveloper)
                   ReDim Preserve saFile(0 To UBound(saFile) + 1)
                   saFile(UBound(saFile)) = sFile
                   dicTask(sTaskDeveloper) = saFile
               End If
           End If
       Next i
      
       ‘————————–
      ‘Organize data for printing
      ‘————————–
      ReDim saMatrix(1 To dicTask.Count + 2, 1 To dicTask.Count + 2)
       ‘Headers
      For i = 3 To dicTask.Count + 2
           saHeader = Split(dicTask.Keys(i – 3), “:”)
           saMatrix(i, 1) = saHeader(1)
           saMatrix(i, 2) = saHeader(0)
           saMatrix(1, i) = saHeader(1)
           saMatrix(2, i) = saHeader(0)
       Next i
      
       ‘Add data
      For i = 3 To dicTask.Count + 2
           For j = 3 To dicTask.Count + 2
               If i > j Then
                   sFile = FilesIntersect(dicTask.Items(i – 3), dicTask.Items(j – 3))
                   If Len(sFile) > 0 Then
                       saMatrix(i, j) = sFile
                       saMatrix(j, i) = sFile
                   End If
               End If
           Next j
       Next i
      
       ‘Print data
      rData.Resize(UBound(saMatrix, 1), UBound(saMatrix, 2)).Offset(, rData.Column + 3) = saMatrix
      
       ‘Clean up
      Set dicTask = Nothing: Set vData = Nothing
       Erase saMatrix: Erase saFile
      
   End Sub
   Private Function FilesIntersect(ByVal vFile1 As Variant, ByVal vFile2 As Variant) As String
      
       Dim i As Integer, j As Integer
       Dim saFile() As String, sTemp As String
      
       ReDim saFile(0 To 0)
       ‘Delete any repetitions and sort
      For i = 0 To UBound(vFile1)
           For j = 0 To UBound(vFile2)
               If vFile1(i) = vFile2(j) Then
                   If Len(saFile(0)) > 0 Then
                       ReDim Preserve saFile(0 To UBound(saFile) + 1)
                       saFile(UBound(saFile)) = vFile1(i)
                   Else
                       saFile(0) = vFile1(i)
                   End If
               End If
           Next j
       Next i
      
       ‘Sort
      If Len(saFile(0)) > 0 Then
           For i = 0 To UBound(saFile) – 1
               For j = 1 To UBound(saFile)
                   If saFile(i) > saFile(j) Then
                       sTemp = saFile(j)
                       saFile(j) = saFile(i)
                       saFile(i) = sTemp
                   End If
               Next j
           Next i
           FilesIntersect = Join(saFile, “,”)
       Else
           FilesIntersect = vbNullString
       End If
      
   End Function
   Private Function InArray(ByVal vArray As Variant, ByVal sStr As String) As Boolean

       Dim i As Integer
      
       InArray = False
       For i = 0 To UBound(vArray)
           If sStr = vArray(i) Then
               InArray = True
               Exit For
           End If
       Next i
      
       Set vArray = Nothing
      
   End Function

5. […] I thought a disconnected recordset might help clean up the code. Sub MakeDynamicADO()  … [full post] Dick Kusleika Daily Dose of Excel vba 0 0 0 0 0 […]

6. To filter the unique records with their data you need only 2 lines: (based on the ‘Matrix with Arrays’ example)

   Sub tst5()
     sq = Split(Replace(Join(Filter([transpose(if(countif(offset($B$1,,,row(B1:B15)),B1:B15)>1,“,” & C1:C15,A1:A15 & “|” & B1:B15&“|” & C1:C15))], “”), vbCr), vbCr & “,”, “,”), vbCr)
     Cells(20, 1).Resize(UBound(sq) + 1) = Application.Transpose(sq)
   End Sub

7. […] A few days ago, Kusleika posted an article that showed how to code a Dynamic Matrix in Excel. He later came back with code to achieve a matrix using ADO. […]

Posting code? Use <pre> tags for VBA and <code> tags for inline.