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.