excelvbadoevents

Does using multiple DoEvents in a nested loop make any sense in Excel VBA?


I have a procedure which can run very long. Yesterday it took 14 hours to complete. This piece of code is looping over the values of a column, which holds filenames of images, and searches through an array that holds all the files including the path from a location that the user selected. In this particular case, the filename column contained nearly 2600 filenames and the array to search more than 12000 records. (that's over 31 million iterations, any suggestions, if this can be improved, are welcome ;-))

In this procedure I use DoEvents to keep Excel responsive. But I just wondered if it makes sense to have two DoEvents. One in every loop (see code below). All the processing is done in this piece of code. Which in this case ran more than 14 hours.

 For Each cell In ActiveSheet.Range("A1:A" & Range("A1").End(xlDown).row)
        DoEvents
        fileCopied = False
        fileName = cell.Value

        If Not (IsStringEmpty(fileName)) Then
            DoEvents
            For i = LBound(imgArray) To UBound(imgArray)
                If Not (IsStringEmpty(CStr(imgArray(i)))) Then
                    If ExactMatch Then
                        If (fsoGetFileName(imgArray(i)) = fileName) Then
                            If DoesFileExist(moveToPath & GetFileName(imgArray(i))) And Not OverwriteExistingFile Then
                                FileCopy imgArray(i), moveToPath & GetFileName(imgArray(i)) & "-" & Format(Now, "yyyymmddhhmmss")
                            Else
                                FileCopy imgArray(i), moveToPath & GetFileName(imgArray(i))
                            End If
                            fileCopied = True

                            If fileCopied Then
                                If fileCopied Then
                                    Range("B" & cell.row).Value = imgArray(i)
                                End If
                            End If
                        End If
                    End If
                End If
            Next i
        End If
    Next

As you can see, I added two DoEvents. But if only one is enough what would be the best place to add it. In the main loop or in the nested loop.

UPDATE:

Rereading the article DoEvents and DoEvents (automateexcel) made clear not to use multiple DoEvents. DoEvents are necessary in this case due to the long-running procedure. But I don't call it on every iteration now. As suggested I use:

If i Mod 100 = 0 Then DoEvents

UPDATE:

Thanks to FreeFlow I was able to gain significant performance improvements. By using the filter function available instead of looping over the Array which contained more than 12000 records. Using the filter function, speeded the process up from hours to seconds.

UPDATE:

The end result is:

 fileNameString = GetFilesUsingCMD(filePath)

If Not (IsStringEmpty(fileNameString)) Then
    Dim imgArray As Variant: imgArray = Split(fileNameString, "|")
    rowCount = ActiveSheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    fileNameArray = Application.Transpose(ActiveSheet.Range("A:A"))
    activeRow = 0

    For fn = LBound(fileNameArray) To UBound(fileNameArray)
        fileName = fileNameArray(fn)

        If Not (IsStringEmpty(fileName)) Then
            If fn Mod 10 = 0 Then
                Progress.Update fn, rowCount, "(Nr. of files:" & CStr(UBound(imgArray)) & ") Executing time: " & CStr(Format((Timer - StartTime) / 86400, "hh:mm:ss")), fileName, True
                DoEvents
            End If

            If Not ExactMatch Then
                resultArray = Filter(imgArray, fileName, True, vbTextCompare)
            Else
                resultArray = Filter(imgArray, fileName)
            End If

            If (UBound(resultArray) > -1) Then

                For i = LBound(resultArray) To UBound(resultArray)

                    If Not OverwriteExistingFile Then
                        If i = 0 Then
                            newFileName = GetFileName(resultArray(i))
                        Else
                            newFileName = CreateFileName(GetFileName(resultArray(i)), CStr(i))
                        End If
                    Else
                        newFileName = GetFileName(resultArray(i))
                    End If
                    FileCopy resultArray(i), moveToPath & newFileName

                    If Not OrgLocationAsLink Then
                        ActiveSheet.Cells(fn, i + 2).Value = imgArray(i) & " (" & newFileName & ")"
                    Else
                        ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(fn, i + 2), Address:=resultArray(i)
                    End If

                Next i

            Else
                ActiveSheet.Range("B" & fn).Value = "** NOT Available **"
                ActiveSheet.Range("B" & fn).Font.Color = RGB(250, 0, 0)
            End If
        End If
    Next fn
End If

As said, because of the Filter-function (Filter Function) I could get rid of the nested loop which iterated over 12000 times for each row on the sheet.


Solution

  • I would remove the DoEvents in the main loop, and remain the nested loop one.

    By the way, I will add Application.ScreenUpdating = False at the beginning of Sub.

    The post below could be helpful.

    https://wellsr.com/vba/2018/excel/vba-doevents-and-when-to-use-it/