Excel VBA make a script asynchronous

asynchronous, excel, vba

Solution

You can't do too much about this unfortunately since VBA runs in a single thread.

You can however introduce a degree of responsiveness by putting

VBA.DoEvents()

in various places in your code, ideally in the tight loops. In your case, put them just after the lines containing `For`. This pauses the VBA and flushes the event queue which will have the effect of making Excel responsive.

(Toggling the screen updating is a bad idea since you might leave things in a bad state if the function terminates unexpectedly. I'd remove the lines that do that if I were you.)

Problem

I have a script that can ping a list of computers and change their background color depending after the result it gets. My problem is, that it blocks the entire excel file while it runs. So my question is, how can I make it to run async? Here is the code: ``` 'ping Function sPing(sHost) As String Dim oPing As Object, oRetStatus As Object Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _ ("select * from Win32_PingStatus where address = '" & sHost & "'") For Each oRetStatus In oPing If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then sPing = "timeout" 'oRetStatus.StatusCode <- error code Else sPing = sPing & vbTab & oRetStatus.ResponseTime & Chr(10) End If Next End Function Sub pingall_Click() Dim c As Range Dim p As String Application.ScreenUpdating = True For Each c In ActiveSheet.Range("A1:N50") If Left(c, 7) = "172.21." Then p = sPing(c) If p = "timeout" Then c.Interior.ColorIndex = "3" ElseIf p < 16 And p > -1 Then c.Interior.ColorIndex = "4" ElseIf p > 15 And p < 51 Then c.Interior.ColorIndex = "6" ElseIf p > 50 And p < 4000 Then c.Interior.ColorIndex = "45" Else c.Interior.ColorIndex = "15" End If End If Next c Application.ScreenUpdating = False ```

Original source