VBA Code Correction Assistance (Data Validation Combobox)

H

hubhockey

New Member
Joined
Jun 8, 2011
Messages
4
I have a pretty elaborate file that uses a lot of cell locking and display box messaging code depending on different varibales within the sheet. The file is made up of many different data validation lists as well. All the locking, messaging, and validation dropdown lists work correctly.

My issue comes when I try to add a Combobox (named "TempCombo") to allow the user to use the autocomplete function option. Once I add the combobox and the corrosponding code I found from the Contextures website, the combobox appears when I select a data validation cell but none of the list options appear in the box.

Any help would be greatly appriciated. I can also email the file to anyone who thinks they may be able to help out.

Thank you.

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains a data validation list
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = ws.Range(str).Address
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
  End If
 
errHandler:
  Application.EnableEvents = True
  Exit Sub
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    EventProc1 Target
    EventProc2 Target
    EventProc3 Target
    EventProc4 Target
    EventProc5 Target
    EventProc6 Target
    EventProc7 Target
    EventProc8 Target
 
End Sub
 
 
Private Sub EventProc1(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("I3").Value >= 1.04166666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("D4:D38").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("D4:D38").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc2(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("I3").Value >= 1.04166666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("G4:I38").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("G4:I38").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc3(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("I39").Value >= 0.166666666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("D40:D43").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("D40:D43").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc4(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("I39").Value >= 0.166666666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("G40:I43").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("G40:I43").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc5(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("S3").Value >= 0.166666666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("P4:P7").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("P4:P7").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc6(ByVal Target As Range)
If Range("E1").Value = "CLOSED" Or Range("S3").Value >= 0.166666666666667 Then
ActiveSheet.Unprotect ("wfmadmin")
Range("R4:T7").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("R4:T7").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc7(ByVal Target As Range)
If Range("G1").Value = "CLOSED" Then
ActiveSheet.Unprotect ("wfmadmin")
Range("P9:P12").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("P9:P12").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub EventProc8(ByVal Target As Range)
If Range("G1").Value = "CLOSED" Then
ActiveSheet.Unprotect ("wfmadmin")
Range("R9:R12").Locked = True
ActiveSheet.Protect ("wfmadmin")
Else
ActiveSheet.Unprotect ("wfmadmin")
Range("R9:R12").Locked = False
ActiveSheet.Protect ("wfmadmin")
End If
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   EventProc9 Target
   EventProc10 Target
   EventProc11 Target
   EventProc12 Target
   EventProc13 Target
   EventProc14 Target
   EventProc15 Target
   EventProc16 Target
   EventProc17 Target
 
End Sub
 
 
Private Sub EventProc9(ByVal Target As Range)
 
    If Not Intersect(Target, Range("D4:D38")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc10(ByVal Target As Range)
 
    If Not Intersect(Target, Range("G4:I38")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc11(ByVal Target As Range)
 
    If Not Intersect(Target, Range("D40:D43")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc12(ByVal Target As Range)
 
    If Not Intersect(Target, Range("G40:I43")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc13(ByVal Target As Range)
 
    If Not Intersect(Target, Range("P4:P7")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc14(ByVal Target As Range)
 
    If Not Intersect(Target, Range("R4:T7")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc15(ByVal Target As Range)
 
    If Not Intersect(Target, Range("P9:P12")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc16(ByVal Target As Range)
 
    If Not Intersect(Target, Range("R9:R12")) Is Nothing Then
        If Target.Locked Then MsgBox "Day closed! Requests & adjustments must be emailed to the Workforce Management Team for approval. Thank you!"
    End If
End Sub
 
 
Private Sub EventProc17(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
If cboTemp.Visible = True Then
  With cboTemp
    .Top = 10
    .Left = 10
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End If
errHandler:
  Application.EnableEvents = True
  Exit Sub
End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Hello, I think the problem is with this line:

Rich (BB code): 
.ListFillRange = ws.Range(str).Address

ws is referring to the ActiveSheet, and your range is probably on a different sheet.

Contextures' example had this statement:
Rich (BB code): 
.ListFillRange = str
....where str was the name of a range with Workbook Scope.

Is your Validation list also using a named range with Workbook Scope?
If so, you should be able to return to the statement in Contextures' example.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Adding extra Or value to this VBA code
2
Replies
10
Views
144
MeaclH
M
D
  • Question Question
VBA to lock Cell after Data Entry but still Allow Sort & Filter ?
Replies
3
Views
237
Jeffrey Mahoney
Jeffrey Mahoney
M
  • Question Question
Prevent worksheet change from triggering when similar macro is executed?
Replies
1
Views
141
AlphaFrog
AlphaFrog
S
  • Question Question
Excel VBA Help
Replies
1
Views
90
DanteAmor
DanteAmor
M
  • Question Question
Where to protect sheet in this code?
Replies
1
Views
92
Micron
M

Forum statistics

Threads
1,224,599
Messages
6,179,831
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top