Ttykuu

I have a macro in Excel that updates a recordset using WHERE a primary key in MS Access matches a primary key in a UserForm label value. The macro is called from a Userform command button, this command button also writes about 10 different UserForm textbox values back to MS ACCESS and to a Sheet in Excel. My query in MS ACCESS is using PARAMETERS as well.

I find that at times my UPDATE query takes a little longer to run, and Excel will freeze. Experts, is there anything missing from my code that I should be executing?

UPDATE SQL MACRO

Sub pbsupdate()
Dim db As Database
Dim qdf As QueryDef

Application.StatusBar = "Connecting to PBS Database......"
Set db = OpenDatabase("M:Admin VisionPBS BackUP DatabaseDatabase15.mdb")
Set qdf = db.QueryDefs("pbsupdate")

Application.StatusBar = "Uploading Client Data to PBS server...."
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

 qdf!pbskey = dialer.key
 qdf!pbsclient = dialer.client
 qdf!pbspriority = dialer.priority_
 qdf!pbssource = dialer.priority
 qdf!pbslastcontact = dialer.contact
 qdf!pbsresult = dialer.result
 qdf!pbsnextsteps = dialer.segmentType
 qdf!pbsattempts = dialer.Label11 + 1
 qdf!pbsnotes = dialer.notes

 Application.CalculateUntilAsyncQueriesDone

 qdf.Execute dbFailOnError

qdf.Close
db.Close
Application.StatusBar = "Upload Successful!"

Set qdf = Nothing
Set cdb = Nothing

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

USERFORM CODE

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = wb.Sheets("clientmenu")
Dim lastrow As Long
Dim CellRow As Integer ' create a variable to hold the cell row

CellRow = ActiveCell.Row
x = Me.lblRow
CurrentRow = ActiveCell.Row


 If contact.Value <> "" And result.Value = vbNullString Then
 MsgBox "Please enter a result"
 result.BorderColor = vbRed
 result.BackColor = vbYellow
 result.DropDown

 Exit Sub

 ElseIf contact.Value = vbNullString And result.Value <> "" Then

 MsgBox "Please enter a date"
 contact.BorderColor = vbRed
 contact.BackColor = vbYellow

Exit Sub
End If

 ClientUpdate '///calling UPDATE SQL MACRO

 Unload Me

With Sheet3
lastrow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1

If Me.priority_ = vbNullString Then

 .Cells(x, 2).Interior.Color = vbWhite
 .Cells(x, 2).Font.Color = RGB(0, 0, 0)

ElseIf Me.priority_ = "None" Then 

 .Cells(x, 2).Interior.Color = vbWhite
 .Cells(x, 2).Font.Color = RGB(0, 0, 0)
 .Cells(x, 3).Value = vbNullString


ElseIf Me.priority_ = "High" Then


 .Cells(x, 2) = Me.priority_.Text
 ElseIf Me.priority_ = "Medium" Then


 .Cells(x, 2) = Me.priority_.Text
 ElseIf Me.priority_ = "Low" Then


 .Cells(x, 2) = Me.priority_.Text

End If

 .Cells(x, 2) = Me.client.Text
 .Cells(x, 4) = Me.priority.Text
 .Cells(x, 9) = Me.notes.Text
 .Cells(x, 7) = Me.segmentType.Text

If Me.contact.Value = vbNullString Then

 Exit Sub
Else

 .Cells(x, 5) = Me.contact.Value

End If

 .Cells(x, 6) = Me.result.Text

If Me.contact = vbNullString Then

 ElseIf Me.contact <> vbNullString Then

 .Cells(x, 8) = .Cells(x, 8) + 1

End If

 End With

 callbyMonth 'filters call by months
 callsByDay 'filters calls by day
 callsByWeek 'filters calls by week

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub