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