Función Backgroundworker y su uso en VBA

Primero agradecer por toda la ayuda brindada, y bueno ahora la nueva pregunta.

Tengo una macro que tarda muchísimo en completar su proceso, el tema es que leí sobre la función Backgroundworker y quisiera saber si es posible aplicarla, les dejo el código de la macro y quedo a la espera de su ayuda, y nuevamente muchas gracias !

Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub Test_Descarga_Archivos_XML_nvr()
'Rutina para descargar Archivos
'En la variable RutaGuardar indicas la ruta base donde los va a guardar los DTE´s
Dim Res As Boolean, RutaGuardar As String, Nombre As String, StrDato As String
Dim xmlDoc As Object, objNodeList As Object
Dim Count As Long
Dim i As Long
Dim j As Integer
Dim URLFactura As String
Dim Largo As Integer
Dim c As Integer
Count = Range("a4").End(xlDown).Row

For i = 5 To Count
Cells(i, 2).Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1],""v01"",""depot"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Select
URLFactura = Cells(i, 2)
Selection.ClearContents
RutaGuardar = CurDir '("C:\") '"C:\" 'Aqui editas la ruta donde deseas se guarden
If VBA.Right(RutaGuardar, 1) <> Application.PathSeparator Then RutaGuardar = RutaGuardar & Application.PathSeparator
Nombre = "FacturaXML.xml"
On Error Resume Next
Res = DescargarArchivo("" & URLFactura & "", RutaGuardar & Nombre)
If Not Res Then
'MsgBox "No se pudo descargar el archivo", vbCritical
On Error Resume Next
Else
Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
xmlDoc.Load RutaGuardar & Nombre 'carga el documento
If (xmlDoc.parseError.ErrorCode <> 0) Then
Dim myErr
On Error Resume Next
Set myErr = xmlDoc.parseError
' MsgBox ("Hubo un error " & myErr.reason)
Else
'recupera nodos
Cells(i, 2).Select
Set objNodeList = xmlDoc.getElementsByTagName("RUTEmisor")
On Error Resume Next
ActiveCell = objNodeList.Item(0).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("TipoDTE")
On Error Resume Next
ActiveCell = objNodeList.Item(0).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("Folio")
On Error Resume Next
ActiveCell = objNodeList.Item(0).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("Referencia")
Largo = objNodeList.Length - 1
For j = 0 To Largo
Set objNodeList = xmlDoc.getElementsByTagName("TpoDocRef")
On Error Resume Next
ActiveCell = objNodeList.Item(j).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("FolioRef")
ActiveCell = objNodeList.Item(j).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("Detalle")
Largo = objNodeList.Length - 1
For j = 0 To Largo
Set objNodeList = xmlDoc.getElementsByTagName("NmbItem")
On Error Resume Next
ActiveCell = objNodeList.Item(j).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Set objNodeList = xmlDoc.getElementsByTagName("DscItem")
ActiveCell = objNodeList.Item(j).Text
If ActiveCell = "" Then
ActiveCell = "Sin Datos"
End If
ActiveCell.Offset(0, 1).Select
Next j
End If
End If
Set xmlDoc = Nothing
Set objNodeList = Nothing
Next i
MsgBox ("Done")
End Sub
Function DescargarArchivo(ByRef URL As String, ByRef RutaNombreArchivoGuardar As String) As Boolean
'Funcion Auxiliar para descargar archivos
On Error Resume Next
Dim Res As Long
Res = URLDownloadToFile(0, URL, RutaNombreArchivoGuardar, 0, 0)
If Err = 0 Then DescargarArchivo = Not CBool(Res)
End Function