Replacing nested loops with dictionary

Let us look at a software performance problem/slowness which I fixed in the VB6 code.

The slowness was when opening a form that showed all the administrators and then rendered a selection of those administrators. You could select a few administrators and those will show as selected when you open the same form again. Somehow the administrator user’s information and the information about who all are selected were stored in different database tables. Original code worked fine for a few years but, once the amount of data grew if the user had selected a few thousand administrators; loading the screen took a few minutes.

The original code was written something like below:

Private Sub DisplayAdministrators()
    Const myProcName = "DisplayAdministrators"
    
    ''define columns in administrator array
    Const f_AdminId = 0
    Const f_AdminAbbr = 1
    Const f_Name = 2 

    Dim lng As Long
    Dim lngRow As Long
    Dim lngTopRow As Long
    Dim vntAdministrators As Variant

    'fill administrators grid
    vntAdministrators = m_objClient.GetAllAdministrators()
    
    If Not IsEmpty(vntAdministrators) Then
        With grdAdministrators
            .Redraw = False
            .MaxRows = UBound(vntAdministrators, 2) + 1
            For lngRow = 0 To UBound(vntAdministrators, 2)
                .Row = lngRow + 1
                .Col = 0
                .Text = vntAdministrators(f_AdminId, lngRow)
                .Col = 1
                .Text = vntAdministrators(f_AdminAbbr, lngRow)
                .Col = 2
                .Text = vntAdministrators(f_Name, lngRow)
            Next lngRow
            .Redraw = True
        End With
        
        'set active row and select rows for any AdministratorISs passed in
        With grdAdministrators
            lngTopRow = .MaxRows
            For lng = 0 To UBound(m_vntSelectedIDs)
                For lngRow = 1 To .MaxRows
                    .Row = lngRow
                    .Col = 0
                    If m_vntSelectedIDs(lng) = .Text Then
                        If lngTopRow >= lngRow Then
                            lngTopRow = lngRow
                        End If
                    End If
                Next lngRow
            Next lng
            .Col = 2
            .Row = lngTopRow
            .Action = ActionActiveCell
            For lng = 0 To UBound(m_vntSelectedIDs)
                For lngRow = 0 To .MaxRows
                    .Row = lngRow
                    .Col = 0
                    If m_vntSelectedIDs(lng) = .Text Then
                        .SelModeSelected = True
                    End If
                Next lngRow
            Next lng
            .Row = .ActiveRow
        End With
    
    End If
End Sub

In the later part of the procedure, the nested loops cause a lot of CPU cycles to be spent to get the output. The inner loop is to find out the intended row from the grid (index of it).

We can store an administrator ID’s index in a dictionary (where key will be administrator ID and the vlaue will be its index in the grid). In the nested loop, we will have to just look up for the administrator ID in the dictionary.

Lets us look at the code change:

Private Sub DisplayAdministrators()
    Const myProcName = "DisplayAdministrators"
    
    ''define columns in administrator array
    Const f_AdminId = 0
    Const f_AdminAbbr = 1
    Const f_Name = 2 

    Dim dictAdministratorIdIndex As New Dictionary
    Dim lng As Long
    Dim lngRow As Long
    Dim lngTopRow As Long
    Dim vntAdministrators As Variant
    Dim vntKey As Variant

    'fill administrators grid
    vntAdministrators = m_objClient.GetAllAdministrators()
    
    If Not IsEmpty(vntAdministrators) Then
        With grdAdministrators
            .Redraw = False
            .MaxRows = UBound(vntAdministrators, 2) + 1
            For lngRow = 0 To UBound(vntAdministrators, 2)
                .Row = lngRow + 1
                .Col = 0
                .Text = vntAdministrators(f_AdminId, lngRow)
                dictAdministratorIdIndex.Add CStr(vntAdministrators(f_AdminId, lngRow)), lngRow + 1 'new line
                .Col = 1
                .Text = vntAdministrators(f_AdminAbbr, lngRow)
                .Col = 2
                .Text = vntAdministrators(f_Name, lngRow)
            Next lngRow
            .Redraw = True
        End With
        
        'set active row and select rows for any AdministratorIDs passed in
        With grdAdministrators
            lngTopRow = .MaxRows
            If dictAdministratorIdIndex.Count > 0 Then
                For lng = 0 To UBound(m_vntSelectedIDs)
                    lngRow = ItemOrMinusOne(dictAdministratorIdIndex, m_vntSelectedIDs(lng)) ' New line to replace the inner loop with a dictionary search
                    If lngRow > 0 And lngTopRow >= lngRow Then
                        lngTopRow = lngRow
                    End If
                Next
            End If
            .Col = 2
            .Row = lngTopRow
            .Action = ActionActiveCell
            If dictAdministratorIdIndex.Count > 0 Then
                For lng = 0 To UBound(m_vntSelectedIDs)
                    lngRow = ItemOrMinusOne(dictAdministratorIdIndex, m_vntSelectedIDs(lng))
                    If lngRow >= 0 Then
                        .Row = lngRow
                        .Col = 0
                        .SelModeSelected = True
                    End If
                Next lng
            End If
            .Row = .ActiveRow
        End With
    
    End If
End Sub

Public Function ItemOrMinusOne(ByVal dictSource As Dictionary, ByVal strIndexKey As String) As Long
    On Error GoTo Proc_Error
    ItemOrMinusOne = dictSource(strIndexKey)
Proc_Exit:
    Exit Function
Proc_Error:
    ItemOrMinusOne = -1
    Resume Proc_Exit
End Function

Once this change was in place, the time taken by this procedure reduced drastically. It finished in seconds rather than finishing in minutes.

Well, the above code is not perfect (it is not a single solution to replace every nested loop). It will use a little more RAM than before. But, in my case, the increase was just a few MB and we could afford that (always measure).

I hope this helps in case you come across similar problem.