Public BKMName As String 
Public ResultCheck As String 
Public nGenCount As Boolean 
Public bprotected As Boolean 
Public unHighlighted As Boolean 
Public ffSelect As Word.FormField 
Public ffSelectList As Word.ListEntries 
Public ffSelectDropdown As Word.DropDown 
Public HighlightSettings As Word.Range 
Option Explicit 
 
 
Public Sub AOnEntry() 
     
    Set HighlightSettings = Selection.Range 
     
    If Selection.FormFields.Count = 1 Then 
         'No textbox but a check- or listbox
        BKMName = Selection.FormFields(1).Name 
        ResultCheck = ActiveDocument.FormFields(BKMName).Result 
        Call ffGenerator 
        Exit Sub 
    ElseIf Selection.FormFields.Count = 0 And Selection.Bookmarks.Count > 0 Then 
        BKMName = Selection.Bookmarks(Selection.Bookmarks.Count).Name 
        ResultCheck = ActiveDocument.FormFields(BKMName).Result 
        Call ffGenerator 
        Exit Sub 
    Else 
        MsgBox "TOASTIE!!" 
    End If 
    ResultCheck = ffSelect.Result 
     
    Call ffGenerator 
    Exit Sub 
End Sub 
 
Public Function ffGenerator() 
     
    On Error GoTo ErrerHandel 
     
    Set ffSelect = ActiveDocument.FormFields(BKMName) 
    Set ffSelectDropdown = ffSelect.DropDown 
    Set ffSelectList = ffSelectDropdown.ListEntries 
    nGenCount = False 
     
     
     
     
    Dim Data As Variant 
    Data = Array("This", "Works", "Rather", "Well", "Wouldn't", "You", "Say?", "..Next List...") 
    Dim Data2 As Variant 
    Data2 = Array("Data1", "Data2", "Data3", "Data4", "...Previous List") 
     
    Dim i As Integer, i2 As Integer 
     
     
    If ffSelect.Result = "Select an Option" Then 
        Call unHighlighter 
        Exit Function 
         
    ElseIf ffSelect.Result = "..Next List..." Then 
         
         
        ffSelect.Select 
        With ffSelectList 
            .Clear 
            .Add "Select an Option" 
            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 ffGenerator 
    ElseIf ffSelect.Result = "...Previous List" Then 
         
         
        ffSelect.Select 
        With ffSelectList 
            .Clear 
            .Add "Select an Option" 
            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 ffGenerator 
         
    Else 
        nGenCount = False 
         
        Call unHighlighter 
         
         
    End If 
     
    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 
         
        If ffSelect.Result = "...Previous List" Then 
            Call ffGenerator 
            Exit Sub 
        ElseIf ffSelect.Result = "..Next List..." Then 
            Call ffGenerator 
            Exit Sub 
        Else 
            Call unHighlighter 
            Exit Sub 
        End If 
         
    End If 
     
End Sub 
 
Public Function Highlighter() 
     
    If ActiveDocument.ProtectionType <> wdNoProtection Then 
        bprotected = True 
        ActiveDocument.Unprotect Password:="" 
    End If 
     
    HighlightSettings.HighlightColorIndex = wdYellow 
    unHighlighted = False 
     
    If bprotected = True Then 
        ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="" 
    End If 
     
End Function 
 
Public Function unHighlighter() 
     
    If unHighlighted = True Then Exit Function 
     
    If ActiveDocument.ProtectionType <> wdNoProtection Then 
        bprotected = True 
        ActiveDocument.Unprotect Password:="" 
    End If 
     
    HighlightSettings.HighlightColorIndex = wdNoHighlight 
    unHighlighted = True 
     
    If bprotected = True Then 
        ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="" 
    End If 
     
End Function