Specific procedure slowdown after 2007-2010 migration

[Movian]

So,

Nearly done with my migration from 2007 to 2010 however I seem to have one final problem.

A specific procedure that worked very quickly in 2007 has slowed to a crawl after moving to 2010, the procedure loops through the controls on a form and updates their row source. I have worked to speed this process up as well as splitting its previous version (it would update both the parent form and the subform at the same time, I split those into two different functions and now only call the one that needs updating) however the speed improvement is not enough for every day use....

Any thoughts would be appreciated.

Please ignore the horrible nature of the if statement, I am looking at other options to ignore specific controls (if you have a suggestion on that too, I am also listening XD).

Public Sub Refresh_SubFormDropDowns()


Application.Echo False
Dim myrs As New ADODB.Recordset
Dim Language As String


If Not IsNull(GetGlobalSetting("Language")) Then
    Language = GetGlobalSetting("Language")
Else
    Language = "English"
End If


On Error Resume Next
Dim cCont As Control


If UCase(Me.fsubModule.Form.Name) = "TNR SCHEDULING" _
    Or UCase(Me.fsubModule.Form.Name) = "G-CODES" Then
    Exit Sub
End If


For Each cCont In Me.fsubModule.Controls
    If TypeName(cCont) = "ComboBox" _
    And Not cCont.Name = "Tech" _
    And Not cCont.Name = "Phys" _
    And Not cCont.Name = "RefPhys" _
    And Not cCont.Name = "FamPhys" _
    And Not cCont.Name = "ExaminedBy" _
    And Not cCont.Name = "ImageSelect" _
    And Not cCont.Name = "Machine" _
    And Not cCont.Name = "cbCVX" _
    And Not cCont.Name = "cbCPT" _
    And Not cCont.Name = "cbDescription" _
    And Not cCont.Name = "txtName" _
    And Not cCont.Name = "txtLOINC" _
    And Not cCont.Name = "Smoke" _
    And Not cCont.Name = "txtDescription" _
    And Not cCont.Name = "InitImp" And Not cCont.Name = "InitImp1" And Not cCont.Name = "InitImp2" And Not cCont.Name = "InitImp3" And Not cCont.Name = "InitImp4" _
    And Not cCont.Name = "InitImp5" And Not cCont.Name = "InitImp6" And Not cCont.Name = "InitImp7" And Not cCont.Name = "InitImp8" And Not cCont.Name = "InitImp9" And Not cCont.Name = "cbFileList" Then
        If cCont.Parent.Name = "Follow Up Office Visit+" Then
            If Not cCont.Name = "InitRec1" _
            And Not cCont.Name = "InitRec2" _
            And Not cCont.Name = "InitRec3" _
            And Not cCont.Name = "InitRec4" _
            And Not cCont.Name = "InitRec5" _
            And Not cCont.Name = "DermExamNarr" _
            And Not cCont.Name = "Combo12" Then
                cCont.RowSource = "SELECT value, [Order] FROM [tblLookupValues] WHERE [Form1]='" & cCont.Parent.Name & "' AND [Control]='" & cCont.Name & "' and language ='" & Language & "' ORDER BY [Order]"
            End If
        Else
            cCont.RowSource = "SELECT value, [Order] FROM [tblLookupValues] WHERE [Form1]='" & cCont.Parent.Name & "' AND [Control]='" & cCont.Name & "' and language ='" & Language & "' ORDER BY [Order]"
        End If
    Else
        On Error Resume Next
            cCont.Requery
        On Error GoTo 0
    End If
    DoEvents
Next cCont
Application.Echo True
End Sub

~Edit~
Ok I cleaned up the procedure a little, it's quicker but still not quick enough (or as quick as the old version was in 2007)

Public Sub Refresh_SubFormDropDowns()'Stop screen update to increase execution speed.
Application.Echo False


Dim cCont As Control
Dim Language As String


'Get System Language
If Not IsNull(GetGlobalSetting("Language")) Then
    Language = GetGlobalSetting("Language")
Else
    Language = "English"
End If


'Exit sub on specific Edge Cases
If UCase(Me.fsubModule.Form.Name) = "TNR SCHEDULING" _
    Or UCase(Me.fsubModule.Form.Name) = "G-CODES" Then
    Exit Sub
End If


For Each cCont In Me.fsubModule.Controls
    If TypeName(cCont) = "ComboBox" Then
        Select Case cCont.Name
        'Cases to do nothing where row source is specificaly set
        Case "Tech", "Phys", "RefPhys", "FamPhys", "ExaminedBy", "ImageSelect", "Machine", "cbCVX", "cbCPT", "cbDescription", "txtName", "txtLOINC", "Smoke", "txtDescription", "cbFileList"
        Case "InitImp", "InitImp1", "InitImp2", "InitImp3", "InitImp4", "InitImp5", "InitImp6", "InitImp7", "InitImp8", "InitImp9"
        'Update Row Sources
        Case Else
            If cCont.Parent.Name = "Follow Up Office Visit+" Then
                Select Case cCont.Name
                Case "InitRec1", "InitRec2", "InitRec3", "InitRec4", "InitRec5", "DermExamNarr", "Combo12"
                Case Else
                        cCont.RowSource = "SELECT value, [Order] FROM [tblLookupValues] WHERE [Form1]='" & cCont.Parent.Name & "' AND [Control]='" & cCont.Name & "' and language ='" & Language & "' ORDER BY [Order]"
                End Select
            Else
                cCont.RowSource = "SELECT value, [Order] FROM [tblLookupValues] WHERE [Form1]='" & cCont.Parent.Name & "' AND [Control]='" & cCont.Name & "' and language ='" & Language & "' ORDER BY [Order]"
            End If
        End Select
    End If
    'Ensure system responsiveness
    DoEvents
Next cCont


'turn screen updates back on
Application.Echo True
End Sub

[Movian]

Never mind,

tracked the real problem to a different sub that is a non needed feature now so I have deactivated that sub and will not in the update notes it is disabled.

May come back and look at this sub later though


-REAL problem Sub-

Public Sub SetLock()Dim ctl As Control


If eventuser = Me.LockedBy Then
    If currentlock = True Then
        currentlock = False
        Exit Sub
    Else
        currentlock = False
    End If
Else
    currentlock = Me.Locked
End If


On Error Resume Next


Select Case currentlock
    Case True
        For Each ctl In Me.fsubModule.Controls
                Me.fsubModule.Controls(ctl.Name).Locked = True
        Next
    Case False
        For Each ctl In Me.fsubModule.Controls
            Me.fsubModule.Controls(ctl.Name).Locked = False
        Next
End Select


End Sub