Friday, June 9, 2017

Excel/VBA : Multi-threading example

Let us face the fact : there is no multi-threading possibilities for VBA. However, if you have any VBA program in your Excel workbook, create multiple copies of that workbook and finally start that VBA program within each of the copied workbook, you got multiple Excel workbooks (VBA programs) running simultaneously. By definition, that is multi-threading.

One may ask with very good reason why even bother, since we already have easy-to-use multi-threading libraries available for more sophisticated languages ? Sometimes you may not have any other choice. A few years ago I started to work with one "state-of-the-art" analytics library for processing some extremely time-consuming calculations. By that time, all calculations were supposed to be processed in Excel and we did not have any access to real development API. Very fortunately, I discovered a collection of relevant VBA interface functions available for that library. Despite of this amazing discovery, processing calculations in VBA was still annoyingly slow. Finally I decided to test the scheme described above. I created multiple copies of one master workbook (which was having a relevant program for processing required calculations), opened multiple Excel workbooks and finally started a program within each workbook (almost) simultaneously. This was truly a "poor man's multi-threading", but despite of that it really did the job well. Example program in this post is taking this described scheme a bit further, as it completely removes the burden of administrating required Excel workbooks.

The main idea for this program is to create desired amount of active workbook copies (which has a relevant program for processing required calculations) into a folder. Moreover, for each of the workbook copy, corresponding VB script file will be created for starting required VBA program within Excel workbook copy. VB script is also taking care of all relevant administrative responsibilities (cleaning all Excel workbooks and VB script files from folder after program execution). Calculation results from different Excel threads will be printed into a shared text file. It should be noted, that SomeComplexAlgorithm procedure is an entry point for Excel thread (started by VB script). For brevity reasons, the content of this example program has been left to be trivial (simulate random number between one and ten for delay time execution and finally store that number into a collection).

Insert a new VBA module and copy-paste the following program.

Option Explicit
'
' common text file for results from all Excel threads
Private Const resultsFilePathName As String = "C:\Users\Administrator\Desktop\ExcelThreading\shared.txt"
'
Public Sub CreateExcelThreads()
    '
    ' clean results text file
    Dim fileSystem As New Scripting.FileSystemObject
    fileSystem.CreateTextFile resultsFilePathName, True
    Set fileSystem = Nothing
    '
    ' create (and execute) Excel workbook threads
    Dim ExcelThreadsFolderPathName As String: ExcelThreadsFolderPathName = "C:\Users\Administrator\Desktop\ExcelThreading\"
    Dim numberOfExcelThreads As Integer: numberOfExcelThreads = 4
    Dim ExcelThreadName As String
    Dim i As Integer
    '
    For i = 1 To numberOfExcelThreads
        ExcelThreadName = "ExcelThread_" + VBA.CStr(i)
        ExecuteExcelThread "SomeComplexAlgorithm", ExcelThreadName, ExcelThreadsFolderPathName
    Next i
End Sub
'
Public Function ExecuteExcelThread(ByVal TargetProgram As String, ByVal ExcelThreadName As String, ByVal ExcelThreadsPathName As String)
    '
    ' save a copy of current active workbook
    Dim ExcelThreadFilePathName As String: ExcelThreadFilePathName = ExcelThreadsPathName + ExcelThreadName + ".xlsm"
    TargetProgram = ExcelThreadName + ".xlsm!" + TargetProgram
    Dim VBScriptFilePathName As String: VBScriptFilePathName = ExcelThreadsPathName + ExcelThreadName + ".vbs"
    ActiveWorkbook.SaveCopyAs ExcelThreadFilePathName
    '
    ' create commands for VB script file
    Dim fileSystem As New Scripting.FileSystemObject
    Dim writer As Scripting.TextStream
    Set writer = fileSystem.OpenTextFile(VBScriptFilePathName, ForWriting, True)
    ' re-open previously saved Excel workbook
    writer.WriteLine "Set ExcelApplication = CreateObject(""Excel.Application"")"
    writer.WriteLine "Set ExcelWorkbook = ExcelApplication.Workbooks.Open(""" + ExcelThreadFilePathName + """)"
    writer.WriteLine "ExcelApplication.Visible = False"
    ' run target VBA program and close Excel workbook
    writer.WriteLine "ExcelWorkbook.Application.Run """ + TargetProgram + """"
    writer.WriteLine "ExcelApplication.ActiveWorkbook.Close True"
    writer.WriteLine "ExcelApplication.Application.Quit"
    ' delete copies of Excel workbook and VB script
    writer.WriteLine "Set fileSystem = CreateObject(""Scripting.FileSystemObject"")"
    writer.WriteLine "fileSystem.DeleteFile """ + ExcelThreadFilePathName + """"
    writer.WriteLine "fileSystem.DeleteFile """ + VBScriptFilePathName + """"
    writer.Close
    Set writer = Nothing
    Set fileSystem = Nothing
    '
    ' execute VB script
    Dim scriptingShell As Object: Set scriptingShell = VBA.CreateObject("WScript.Shell")
    scriptingShell.Run VBScriptFilePathName
    Set scriptingShell = Nothing
End Function
'
Public Sub SomeComplexAlgorithm()
    '
    ' this is target program to be executed by Excel thread
    ' program creates N random numbers between 1 and 10, stores these into
    ' collection and finally prints the content into a specific text file
    Dim simulationResult As New Collection
    Dim i As Integer
    For i = 1 To 25
        ' due to brevity reasons, we just simulate some time-consuming algorithm
        Dim delayTime As Long: delayTime = WorksheetFunction.RandBetween(1, 10)
        Sleep delayTime
        ' store one simulated result (random delay time) into collection
        simulationResult.Add delayTime
    Next i
    '
    ' print result collection into a specific text file
    ' we have to be prepared for the case in which multiple users (Excel threads)
    ' are accessing the same specific text file at the same time
recoveryPoint:
    On Error GoTo errorHandler
    Dim fileSystem As New Scripting.FileSystemObject
    Dim writer As Scripting.TextStream
    '
    ' if the file is in use, error will be thrown below here
    Set writer = fileSystem.OpenTextFile(resultsFilePathName, ForAppending, False)
    For i = 1 To simulationResult.Count
        writer.WriteLine ActiveWorkbook.Name + "=" + VBA.CStr(simulationResult(i))
    Next i
    writer.Close
    Set simulationResult = Nothing
    Set writer = Nothing
    Set fileSystem = Nothing
    Exit Sub
    '
errorHandler:
    ' get one second delay and re-access text file
    Sleep 1
    Resume recoveryPoint
End Sub
'
Public Function Sleep(ByVal seconds As Long)
    '
    Dim startTime As Long: startTime = VBA.Timer
    Do
        If (VBA.Timer >= (startTime + seconds)) Then Exit Do
    Loop
End Function
'

Simulating 100 random numbers (setting delay time to 1) using just one Excel thread : processing time 0:01:50.














Simulating 100 random numbers (setting delay time to 1) using four Excel threads (25 numbers for each thread) : processing time 0:00:30, which turns out to be almost quadruple time improvement in comparison with single-threaded processing.














Finally, thanks for reading this blog.
-Mike