Multithreading VBA - VBA worker threads via VBscript

Yet again I am approaching the subject of multithreading in VBA. This time I am coming with an interesting alternative to multithreading in VBA compared to the ones I presented previously. So again let me start by repeating that multithreading is possible in VBA but not in “native” VBA. What do I mean by “native”? I mean that VBA as a programming language does not natively support creating new threads, joining threads etc. However, you can achieve multithreading by using external libraries, modules or scripts.

Check out my VBA Multithreading Tool for easy VBA Multithreading!

This post is the result of my previous post EXCEL: Multithreading in VBA using VBscript. In that article I focus on an idea of using the Windows Shell to call multiple VBscript worker threads. Although this allowed me to quite easily achieve multithreading VBA, on the the other hand VBscript turned out to be much slower than VBA therefore even multithreaded algorithms would work slower than a single threaded VBA algorithm. As a result of these findings I decided to leverage VBA worker threads (instead of VBscript threads) via Windows Shell (and VBscript). I know this is fairly complicated so let me explain and continue with a simple example.

How multithreading VBA with VBA worker threads works

As shown above the concept is to replicate as many Excel workbooks as we need threads and then run the macros concurrently via VBscript.

Mulithreading VBA example

This is the code. 60-something lines of code – so not too bad :):

Sub VBAMultithread(maxThreads As Long)
    Dim thread As Long, threads As Long
    For threads = 1 To maxThreads
        startTime = Timer
        For thread = 1 To threads
            CreateVBAThread thread, threads, divTabSize
        Next thread
        CheckIfFinishedVBA threads
    Next threads
End Sub

Sub CreateVBAThread(threadNr As Long, maxThreads As Long, divTabSize As Long)
    Dim s As String, sFileName As String, wsh As Object, threadFileName As String
    '---Save a copy of the Excel workbook---
    threadFileName = ActiveWorkbook.Path & "Thread_" & maxThreads & "_" & threadNr & ".xls"
    Call ActiveWorkbook.SaveCopyAs(threadFileName)
    '---Save the VBscript---
    s = "Set objExcel = CreateObject(""Excel.Application"")" & vbCrLf
    s = s & "Set objWorkbook = objExcel.Workbooks.Open(""" & threadFileName & """)" & vbCrLf
    s = s & "objExcel.Application.Visible = False" & vbCrLf
    s = s & "objExcel.Application.Run ""Thread_" & maxThreads & "_" & threadNr & ".xls!RunVBAMultithread"" ," & threadNr & "," & maxThreads & "," & divTabSize & ",""" & ActiveWorkbook.Name & """" & vbCrLf
    s = s & "objExcel.ActiveWorkbook.Close" & vbCrLf
    s = s & "objExcel.Application.Quit"
    '---Save the VBscript file---
    sFileName = ActiveWorkbook.Path & "Thread_" & threadNr & ".vbs"
    Open sFileName For Output As #1
    Print #1, s
    Close #1
    '---Execute the VBscript file asynchronously---
    Set wsh = VBA.CreateObject("WScript.Shell")
    wsh.Run """" & sFileName & """"
    Set wsh = Nothing
End Sub

Public Sub RunVBAMultithread(threadNr As Long, maxThreads As Long, divTabSize As Long, workbookName As String)
    'A simple division algorithm (a multiplication table would quickly cause overflow)
    Dim i As Long, j As Long, x As Double, startTimeS As Date, endTimeS As Date
    startTimeS = Timer
    '---Compute partition of the division table---
    For i = CInt(CDbl(divTabSize) * (threadNr - 1) / maxThreads + 1) To CInt(CDbl(divTabSize) * threadNr / maxThreads)
       For j = 1 To divTabSize
          x = CDbl(i) / j
       Next
    Next
    endTimeS = Timer
    elapsed = "" & Format(endTimeS - startTimeS, "0.00")
    Dim oXL
    Set oXL = GetObject(, "Excel.Application")
    oXL.Workbooks(workbookName).Sheets("Status").Range("A" & (threadNr + 1)) = elapsed
    Set oXL = Nothing
End Sub

'---------Join threads - wait until all finish and save elapsed time to worksheet----------
Sub CheckIfFinishedVBA(maxThreads As Long)
    Dim endTime As Double, elapsed As String
    Do Until False
        DoEvents
        If Range("A2").Value <> "" Then
            If Range("A2:A" & Range("A1").End(xlDown).Row).Count = maxThreads Then
                endTime = Timer
                elapsed = "" & Format(endTime - startTime, "0.00")
                Range("I1").Offset(maxThreads).Value = elapsed
                Exit Sub
            End If
        End If
        Sleep 50
    Loop
End Sub

Now what do the various procedures do?:

VBAMultithread – the main thread which creates all the worker threads
CreateVBAThread – creates a single thread. Copies the current workbook and creates a VBscript which is executed via Windows Shell. This script will run the RunVBAMultithread macro
RunVBAMultithread – the worker macro which does the computations: which calculates a partition of the division table and save the elapsed time to the Master Excel Workbook
CheckIfFinishedVBA – this macro will execute once all worker threads have been created. It will wait (Sleep and check in loop) until all worker threads have finished in order to evaluate the total execution time of the algorithm

Performance

Please see this post on how this method of multithreading in VBA compares to other available approaches:
EXCEL: Multithreading – VBA vs. VBscript vs. C#.NET