Performance issue A2007, W7

[Minimalist]

I'm new to the forum and need some help with a performance issue. A sales report I designed needs to get recordsource assigned depending of some parameters creating the underlying crosstab (dates). The query works fine but the code assigning the controlsource to the controls on the report is very slow. I need some ideas how to make it faster. Here are the routines I amusing:

Create query and open report:

Private Sub cmdReport_Click()

  Dim dFrom As Date, dTo As Date, qdf As DAO.QueryDef, sSql As String, sQdf As String
  Dim sLast As String, iWhat As Integer

  On Error GoTo cmdReport_Click_Error
  
  If IsNull(Me!cmbReportYear) Or IsNull(Me!frmAgencyCustomer) Then Exit Sub
  sLast = Nz(Me!cmbReportYear, Year(Date))
  sLast = "12/31/" & sLast
  dTo = CDate(sLast)
  dFrom = DateSerial(Year(dTo) - 2, Month(dTo), Day(dTo) + 1)
  iWhat = Nz(Me!frmAgencyCustomer, 0)
  
  sQdf = "qctb_Sales_Report"
  sSql = sSql & "TRANSFORM Sum(qsel_Sales_SW.SaleAmtOfInvoice) AS [Sold Items] "
  If iWhat = 1 Then
    sSql = sSql & "SELECT qsel_Sales_SW.SPNumber AS txtNumber, qsel_Sales_SW.SalesPersonName AS txtName "
  ElseIf iWhat = 2 Then
    sSql = sSql & "SELECT qsel_Sales_SW.CstNumber AS txtNumber, qsel_Sales_SW.BillToName AS txtName "
  End If
  sSql = sSql & "FROM qsel_Sales_SW, tbl_CrosstabSalesReport "
  sSql = sSql & "WHERE (((qsel_Sales_SW.DocumentDate) >= #" & dFrom & "# "
  sSql = sSql & "AND (qsel_Sales_SW.DocumentDate) <= #" & dTo & "#)) "
  If iWhat = 1 Then
    sSql = sSql & "GROUP BY qsel_Sales_SW.SPNumber, qsel_Sales_SW.SalesPersonName "
  ElseIf iWhat = 2 Then
    sSql = sSql & "GROUP BY qsel_Sales_SW.CstNumber, qsel_Sales_SW.BillToName "
  End If
  sSql = sSql & "ORDER BY IIf([FieldName]='Month',Format([DocumentDate],'yyyy-mm')"
  sSql = sSql & ",IIf([FieldName]='Year',Format([DocumentDate],'yyyy')"
  sSql = sSql & ",Format([DocumentDate],'yyyy') & ' Q' & Format([DocumentDate],'q'))) "
  sSql = sSql & "PIVOT IIf([FieldName]='Month',Format([DocumentDate],'yyyy-mm')"
  sSql = sSql & ",IIf([FieldName]='Year',Format([DocumentDate],'yyyy')"
  sSql = sSql & ",Format([DocumentDate],'yyyy') & ' Q' & Format([DocumentDate],'q')));"

  Debug.Print sSql
  
    For Each qdf In CurrentDb.QueryDefs
      If qdf.Name = sQdf Then
        qdf.SQL = sSql
      End If
    Next qdf
    DoCmd.OpenReport "rpt_Sales", acViewReport, , , acHidden, CStr(dTo)
    
cmdReport_Click_Ex:
  On Error Resume Next
  Set qdf = Nothing
  Exit Sub

cmdReport_Click_Error:

  Select Case Err.Number
    Case 0
    Case Else
      MsgBox Err.Number & vbCrLf & Err.Description
      'Call ErrorHandler("cmdReport_Click", "Form_frm_Sales", Nz(Err.Number, 0), _
                         Nz(Err.Description, " "))
    End Select
    Resume cmdReport_Click_Ex
    Resume 'for debugging
End Sub

Loading the report:

Private Sub Report_Load()

  Dim ctl As Control, dFrom As Date, dTo As Date
  
  On Error GoTo Report_Load_Error
     
  dTo = CDate(Me.OpenArgs)
  dFrom = DateSerial(Year(dTo) - 2, Month(dTo), Day(dTo) + 1)
  Me.RecordSource = "qctb_Sales_Report"
  
  
    For Each ctl In Me.Controls
      Debug.Print ctl.Name
      If ctl.ControlType = acTextBox Then Call SetControlSourceSalesPerMonth(ctl)
    Next ctl
    Me!lblYear01.Caption = CStr(Year(dTo))
    Me!lblYear02.Caption = CStr(Year(dFrom))
  
    Me.Visible = True

Report_Load_Ex:
  On Error Resume Next
  Exit Sub

Report_Load_Error:

  Select Case Err.Number
    Case 0
    Case Else
      MsgBox Err.Description & vbCrLf & Err.Number
      'Call ErrorHandler("Report_Load", "Report_rpt_Sales", Nz(Err.Number, 0), _
                         Nz(Err.Description, " "))
  End Select
  Resume Report_Load_Ex
  Resume 'for debugging
End Sub

Setting Controlsource:

Private Sub SetControlSourceSalesPerMonth(ctl As Control)

  Dim fld As DAO.Field, rs As DAO.Recordset, sSql As String, dYear As String
  Dim dTmp As Date

  On Error GoTo SetControlSourceSalesPerMonth_Error
  
  sSql = Me.RecordSource
  Set rs = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
  dTmp = CDate(Nz(Me.OpenArgs, Date))
  
  If Right(ctl.Name, 2) = "01" Then
    dYear = dTmp
  ElseIf Right(ctl.Name, 2) = "02" Then
    dYear = DateAdd("yyyy", -1, dTmp)
  End If
    
    rs.MoveFirst
    If CStr(dYear) <> "" Then
      For Each fld In rs.Fields
        If IsDate(fld.Name) Then
          If Year(fld.Name) = Year(dYear) Then
            If Format(CDate(fld.Name), "mmm") = Mid(ctl.Name, 4, 3) Then
              ctl.ControlSource = fld.Name
            End If
          End If
        Else
          If Left(fld.Name, 4) = CStr(Year(dYear)) Then
            If Right(fld.Name, 2) = Mid(ctl.Name, 4, 2) Then
              ctl.ControlSource = fld.Name
            End If
          Else
            'Debug.Print fld.Name, CStr(Year(dYear))
            If IsNumeric(fld.Name) Then
              If (CLng(fld.Name) + 1 = CLng(Year(dYear))) Or (CLng(fld.Name) - 1 = CLng(Year(dYear))) Then
                ctl.ControlSource = fld.Name
              End If
            End If
          End If
        End If
      Next fld
    Else
      For Each fld In rs.Fields
        If fld.Name = ctl.Name Then ctl.ControlSource = fld.Name
      Next fld
    End If

SetControlSourceSalesPerMonth_Ex:
  On Error Resume Next
  rs.Close
  Set rs = Nothing
  Exit Sub

SetControlSourceSalesPerMonth_Error:
  Debug.Print ctl.Name, fld.Name
  Select Case Err.Number
    Case 0
    Case Else
      MsgBox Err.Description & vbCrLf & Err.Number
      'Call ErrorHandler("SetControlSourceSalesPerMonth", "Report_rpt_Sales", Nz(Err.Number, 0), _
                         Nz(Err.Description, " "))
  End Select
  Resume SetControlSourceSalesPerMonth_Ex
  Resume 'for debugging
End Sub

I know the issue is running through the controls and recordset but I have no idea how to do it differently. Any help would be appreciated.

[Rawb]

I don't see any problems with your code except that you're using dbOpenSnapshot instead of dbOpenForwardOnly, which has slightly better performance.

I'm just guessing here, but your issue is probably simply the number of Controls you're having to loop through. Each time you set one of the Form Controls' ControlSource, it takes time. Add enough of those together, and you have your delay. . .

If that's the case, then the only thing you can do is to try and reduce the number of Controls on your Form.