Hello all,
I cannot figure out how to unlock a cell with a value from an activex combobox. The cells that link to the combobox are cells G6:G3000. The cells I need to unlock are in the next row H6:H3000. There was originally just a dropdown list in column G, but I updated to use a combobox as well for more versatility. A single click brings the drop down list in the cell. A double click opens the combobox in the same cell.
Unlocking column H using the dropdown list works fine. Here is the code I used. Case 7 (column G) controls the Lock / unlock status of the corresponding cell in column H
However, the combobox, does not seem to play by the same rules. After double clicking a cell in column G, the combobox appears over the cell you double clicked on. When you chose the entry "Not Listed" in the combobox, even if you Tab, Enter, or right arrow over to column H, column H will not unlock. I figured that since I was double clicking on the cell, the cell would respond as a worksheet change the same as the drop down box. I was wrong.
Here is all the code that relates to the combobox.
I hope this code helps.
Thank you in advance
Jim
I cannot figure out how to unlock a cell with a value from an activex combobox. The cells that link to the combobox are cells G6:G3000. The cells I need to unlock are in the next row H6:H3000. There was originally just a dropdown list in column G, but I updated to use a combobox as well for more versatility. A single click brings the drop down list in the cell. A double click opens the combobox in the same cell.
Unlocking column H using the dropdown list works fine. Here is the code I used. Case 7 (column G) controls the Lock / unlock status of the corresponding cell in column H
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Union(Range("G6:G3000"))
Set r = Intersect(Target, r)
If Not r Is Nothing Then
Application.EnableEvents = False
For Each c In r
Select Case True
Case 7 = c.Column 'G
If c.Value = "Not Listed" Then
Cells(c.Row, "H").Locked = False
Else
Cells(c.Row, "H").Locked = True
Cells(c.Row, "H").Value = ""
End If
Case Else
End Select
Next c
End IfHowever, the combobox, does not seem to play by the same rules. After double clicking a cell in column G, the combobox appears over the cell you double clicked on. When you chose the entry "Not Listed" in the combobox, even if you Tab, Enter, or right arrow over to column H, column H will not unlock. I figured that since I was double clicking on the cell, the cell would respond as a worksheet change the same as the drop down box. I was wrong.
Here is all the code that relates to the combobox.
VBA Code:
Private Sub MDList_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
MDList.Visible = False
Case 37 'Lt Arrow
ActiveCell.Offset(0, -1).Activate
MDList.Visible = False
Case 39 'Rt Arrow
ActiveCell.Offset(0, 1).Activate
MDList.Visible = False
Case 13
ActiveCell.Offset(0, 1).Activate
MDList.Visible = False
'Case Else 'do nothing
End Select
End Sub
Private Sub TempCombo_LostFocus()
With Me.TempCombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Dim lSplit As Long
Dim wb As Workbook
Dim nm As Name
Dim wsNm As Worksheet
Dim rng As Range
Set ws = ActiveSheet
Set wsList = Sheets("List")
Set cboTemp = ws.OLEObjects("MDList")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then
Cancel = True
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
'for simple INDIRECT function (English)
' e.g. =INDIRECT(B2)
'will create dependent list of items
If Left(str, 4) = "INDI" Then
lSplit = InStr(1, str, "(")
str = Right(str, Len(str) - lSplit)
str = Left(str, Len(str) - 1)
str = Range(str).Value
End If
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 25
.Height = Target.Height + 15
.ListFillRange = str
If .ListFillRange <> str Then
'for dynamic named ranges
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
Set wb = ActiveWorkbook
Set nm = wb.Names(str)
Set wsNm = wb.Worksheets _
(nm.RefersToRange.Parent.Name)
Set rng = wsNm.Range _
(nm.RefersToRange.Address)
.ListFillRange = "'" & wsNm.Name _
& "'!" & rng.Address
End If
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End SubI hope this code helps.
Thank you in advance
Jim
