Gfrktyl

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 ClientUpdate ()

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