improve speed of code?

[OTWarrior]

This is actually from my first post in the KB, but I have been going through the code in order to speed it up. any ideas would be much appreciated (although I have made some amendments already, if it can be made faster it would be great)

The purpose of this code is to clear a formfield dropdown list when a certain value is chosen, and to repopulate the list with values from an array. The dropdown menu is then automatically brought down (to show the new list) and will not let you leave the drop down menu until a valid option is chosen.

here is the code for the whole process:

[VBA]Public Sub BOnEntry()
Set HighlightSettings = Selection.Range
With Selection
If .FormFields.Count = 1 Then
'No textbox but a check- or listbox
BKMName = .FormFields(1).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
ElseIf .FormFields.Count = 0 And .Bookmarks.Count > 0 Then
BKMName = .Bookmarks(.Bookmarks.Count).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
Else
MsgBox "System Error ~ Please re-select a dropdown menu", 64
End If
End With
ResultCheck = ffSelect.Result
Call ffGeneratorService
Exit Sub
End Sub

Public Function ffGeneratorService()
On Error GoTo ErrerHandel
Set ffSelect = ActiveDocument.FormFields(BKMName)
Set ffSelectDropdown = ActiveDocument.FormFields(BKMName).DropDown
Set ffSelectList = ActiveDocument.FormFields(BKMName).DropDown.ListEntries
nGenCount = False
'service list 1 - 21 items
Data = Array("random data", "..Next Service List...")
'Service list 2 - 23 items
Data2 = Array("random data", "...Previous Service List")
'
With ffSelect
If .Result = "Select a Service" Then
Call unHighlighter
Exit Function
ElseIf .Result = "..Next Service List..." Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i2 = LBound(Data2) To UBound(Data2)
.Add Data2(i2)
Next i2
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
ElseIf .Result = "...Previous Service List" Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i = LBound(Data) To UBound(Data)
.Add Data(i)
Next i
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
Else
nGenCount = False
'Application.ScreenUpdating = True
Call unHighlighter
End If
End With
'
Exit Function
ErrerHandel:
MsgBox Err.Description, 64, Err.Number
Exit Function
End Function

Public Sub AOnExit()
Set ffSelect = ActiveDocument.FormFields(BKMName)
If nGenCount = True Then
Call Highlighter
Exit Sub
Else
Select Case ffSelect.Result
Case "...Previous Service List"
Call ffGeneratorService
Case "..Next Service List..."
Call ffGeneratorService
Case Else
Call unHighlighter
End Select
End If
End Sub

Public Function Highlighter()
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdYellow
unHighlighted = False
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function

Public Function unHighlighter()
If unHighlighted = True Then Exit Function
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdNoHighlight
unHighlighted = True
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function[/VBA]

NB: the code works fully, I just want to make it faster
Thanks in advance.

[TonyJollans]

I couldn't fully understand what was going on with this so I went and checked the KB and downloaded the sample.

I still haven't worked it all out (I will, and come back, later) but ...

... Word 2007 won't accept your SelfCert. I don't know much about this stuff but it rings a vague bell and I'm going to see what I can find out. Meanwhile, I think, anyone with only Word 2007 will not be able to use this.

I think this is probably a general note for all KB authors not to use SelfCert.

[OTWarrior]

I described what the code is doing above.

however, I did not realise that all my code was bound to my certificate, I thought was an optionial thing?
Is there a way of changing my kb post?

On to the topic, the code above is more refined and faster than the KB version, and I just wanted to check that everything I have written is the fastest way.

if you want to test this code yourself, add a drop down form field, make the entry macro BonEntry, and the exit macro AonExit, and make sure that
"...Previous Service List" or "..Next Service List..." are options on the dropdown list (along with some other options)

[TonyJollans]

I'm probably missing something obvious but I don't see the purpose of the Entry macro - and it certainly doesn't need code dependent upon formfield type as its only use is on entry to a dropdown.

Sorry - I don't know the procedure for changing KB entries - I think you need to get an admin to set it back to a pending state - I think there's a forum for asking this kind of thing.

[OTWarrior]

the onentry code is to get the name of the form field, as this code is used with more than one (its actually used in my document for 28 form fields).

[TonyJollans]

As a side note - there's something really funny with long (scrollable) code boxes in IE7 - they seem alright in FF.

Anyway - I've taken the code form here now and ..

What is HighlightSettings?

[OTWarrior]

oops, its declared at the start of the module
[vba]Public HighlightSettings As Word.Range
Public BKMName As String
Public ResultCheck As String
Public nGenCount As Boolean
Public unHighlighted As Boolean
Public ffSelect As Word.FormField
Public ffSelectList As Word.ListEntries
Public ffSelectDropdown As Word.DropDown [/vba]

[TonyJollans]

Ignore that question - I see now.

[TonyJollans]

Too late

[TonyJollans]

I'm sorry but I'm really struggling to understand all the twists in this code. I can't see that the entry macro serves any useful purpose and I can't understand the purpose of the recursive calls to ffGeneratorService.

The basic logic is

(On Exit)
If (Next Service List) or (Previous Service List) Then

[TonyJollans]

Sorry pressed the wrong key - let me try again

The basic logic is

(On Exit)
If (Next Service List) or (Previous Service List) Then
Clear the dropdown
Rebuild from appropriate array
Drop the list down
Reselect the field
EndIf

If that's all it is then just code that and it will be more efficient.

I haven't worked out the highlighting completely but I'm sure it can be incorporated into a single stream of code.

[TonyJollans]

Now I understand what the code is doing

Most of the convoluted logic is to unhighlight in just about every place except the right one. Essentially you only want to unhighlight when you leave the Exit routine - in other words when you actually let the user exit the field - and even then only if you have actually highlighted it in the first place so put this as the very last thing in the exit routine, right before the End Sub:
[vba]Call unHighlighter[/vba]
When you've done that you can remove all the rest of the logic for unHighlighting. Also you can remove nGenCount (a slightly confusing name for a Boolean) as you can never leave ffGeneratorService with it anything other than False, and remove the logic in the Exit routine dependent on it being True. This will leave the main block of logic in ffGeneratorService looking like this:

[vba]If ffSelect.Result = "...Previous List" Then
' populate with previous list and dropdown
ElseIf ffSelect.Result = "..Next List..." Then
' populate with next list and dropdown
End If
[/vba]

Next you have this code:
[vba]ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService[/vba]
in the ffGeneratorService routine after refreshing the dropdown list.

What happens is that the code pauses following the Sendkeys and waits for the user to select from the Dropdown, which is then processed in the recursive call. The recursion is using up resources (and probably performing poorly) and not serving any useful purpose; it would be better to have multiple serial invocations of the routine. One way to do this is to remove the recursive call and to have a loop in the Exit routine:
[vba]
Do
If ffSelect.Result = "...Previous List" Then
Call ffGeneratorService
ElseIf ffSelect.Result = "..Next List..." Then
Call ffGeneratorService
Else
Exit Do
End If
Loop
[/vba]

Finally, for the moment at least, I don't see any purpose in the Entry routine - you can set ffSelect at the beginning of the Exit routine just as easily.

[TonyJollans]

I've had a bit more of a play and I think this will do exactly as your original:
[VBA]
Option Explicit
Public Sub AOnExit()

Dim ffSelect As FormField
Dim Highlighted As Boolean
Dim Data, i

On Error GoTo ErrerHandel

Set ffSelect = Selection.FormFields(1)
Do
Select Case ffSelect.Result
Case "...Previous Service List"
Data = Array("random data", "..Next Service List...")
Case "..Next Service List..."
Data = Array("random data", "...Previous Service List")
Case Else
Exit Do
End Select
With ffSelect
.Select
With .DropDown.ListEntries
.Clear
.Add "Select a Service"
For i = LBound(Data) To UBound(Data)
.Add Data(i)
Next i
End With
.DropDown.Value = 1
Highlighted = Highlighter(ffSelect, True)
DoEvents
SendKeys "%({DOWN})", True
End With
Loop

If Highlighted = True Then
Highlighted = Highlighter(ffSelect, False)
End If

Exit Sub
ErrerHandel:
MsgBox Err.Description, 64, Err.Number
End Sub

Public Function Highlighter(ffSelect, Status As Boolean)
With ActiveDocument
.Unprotect Password:=""
If Status = True Then
ffSelect.Range.HighlightColorIndex = wdYellow
Else
ffSelect.Range.HighlightColorIndex = wdNoHighlight
End If
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End With
Highlighter = Status
End Function[/VBA]

It will almost certainly be more efficient simply because it's more straightforward and doesn't have a lot of unnecessary code - although I have been surprised by VBA performance in the past so I do not guarantee it. One thing that will help is not loading unneeded arrays of dropdown entries.

I have to admit to not knowing exactly why the code pauses after the Sendkeys - and it only does it if the Highlighter routine has been run, presumably because of the unprotection and reprotection.

[OTWarrior]

thank you very much for your help, I did change my version using your code. However, I have kept the onEntry code that mine had as it was crucial.

The way my code runs (which took me a few months to figure out how to do) was to simulate an onChange event, whereas the code you posted unfortunately only runs when to try to leave the form field. It is faster with the highlight function though, so that is diffinately in

having all the options in the case, then clearing the list anyway does seem like an easier way of doing this. I have split my normal code into 2 ffgenerator functions for the different lists i need (BIG speed increase)

I think it may be pausing after sendkeys as it is know opening the list, or sendkeys is slow code (i am guessing here).

Again, thank you for your time and effort into this one

[TonyJollans]

I have split my normal code into 2 ffgenerator functions for the different lists i need (BIG speed increase)

Yes, building lots of arrays you don't need did look like the thing with the most scope for improvement. I wish there were a simple way of initialising arrays at compile time.


The pause after the sendkeys interests me and I want to find out more about it.