Code:
Sub SrchTrackingNums()
Dim Con As ADODB.Connection
Dim strSQL As String
Dim strCon As String
Dim strVariable As String
Dim Cell As Range
Dim Rs As ADODB.Recordset
Dim rCount As Long, Crec As Long
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=z:\Support\ Master.accdb"
rCount = Range("E2").End(xlDown).Row - 1
For Each Cell In Range("E2", Range("E2").End(xlDown))
Crec = Cell.Row - 1
Application.StatusBar = Format(Crec / rCount, "0.00% Completed")
strVariable = Cell.Value
strSQL = "SELECT [Loan_Number],[LOB],[PACKAGE_TYPE],[RequestDateTime] " & _
"FROM [Master] " & _
"WHERE [FedExTrackToConsumer] = '" & strVariable & "';"
Set Rs = New ADODB.Recordset
Rs.Open strSQL, strCon, adOpenForwardOnly, adLockReadOnly, adCmdText
Cell.Offset(0, 3).CopyFromRecordset Rs
Rs.Close
Crec = Crec + 1
Next Cell
Application.StatusBar = ""
Set Rs = Nothing
End Sub
the macro begins and then just stops responding?
Last edited: