Combo box shows no content

[kanadaaa]

Hi, I have a question about the combo box.
When I used the data validation function to add a dropdown list into a cell, the options were too small and I looked for a way to make them bigger.
It seems there are two ways to do this: (i) add a macro to increase the zoom percentage at which you view the sheet, or (ii) use the combo box.
About (i), I asked in a different thread and reached the following code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim lZoom As Long
  Dim lZoomDV As Long
  Dim lDVType As Long
  lZoom = 64
  lZoomDV = 120
  lDVType = 0
  Application.EnableEvents = False
  On Error Resume Next
  lDVType = Target.Validation.Type
    On Error GoTo errHandler
    If lDVType <> 3 Then
      With ActiveWindow
        If .Zoom <> lZoom Then
          .Zoom = lZoom
          .ScrollColumn = 1
          .ScrollRow = 1
        End If
      End With
    Else
      With ActiveWindow
        If .Zoom <> lZoomDV Then
          .Zoom = lZoomDV
        End If
      End With
    End If
exitHandler:
  Application.EnableEvents = True
  Exit Sub
errHandler:
  GoTo exitHandler
End Sub

This works well but if possible, I'd prefer (ii) because the font itself seems to be able to be enlarged.
Then, I followed the instruction provided at Excel Data Validation Combo box and am using the following code:

'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim Tgt As Range
Set Tgt = Target.Cells(1, 1)
Set ws = ActiveSheet
On Error GoTo errHandler

If Tgt.Validation.Type = 3 Then
    Cancel = True
End If

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler

If Tgt.Validation.Type = 3 Then
    Application.EnableEvents = False
    str = Tgt.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Tgt.Left
      .Top = Tgt.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = ws.Range(str).Address
      .LinkedCell = Tgt.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub Worksheet_SelectionChange(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
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, change to KeyUp
'Table with numbers for other keys such as Right Arrow (39)
'https://msdn.microsoft.com/en-us/library/aa243025%28v=vs.60%29.aspx

Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
    Select Case KeyCode
        Case 9 'Tab
            ActiveCell.Offset(0, 1).Activate
        Case 13 'Enter
            ActiveCell.Offset(1, 0).Activate
        Case Else
            'do nothing
    End Select
End Sub
'====================================

But when I double-click on a cell with a data validation setting of List (in which the source is set for something like "=TableName"), the combo box appears but there's no selectable content in it.
I'm wondering how I can resolve this problem. Please give me a hand. Thank you.

 

[Akuini]

I don't think you need data validation + combobox to do that, just a combobox.
Try this in a clean new workbook:
Insert an activex combobox (i.e ComboBox1) & say the range where you want to use the combobox is A1:A10 in sheet1 , and the source is A1:A20 in sheet2 (fill it with some data).
Copy this code to sheet1 code module, & try double-click in a cell in A1:A10 sheet1.

Private Sub ComboBox1_LostFocus()
    ComboBox1.Visible = False
    ComboBox1.LinkedCell = ""
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Sheets("Sheet1").Range("A1:A10")) Is Nothing Then
        
 'setting up combobox property
        With ComboBox1
        .Height = Target.Height + 5
        .Width = Target.Width + 30
        .Top = Target.Top - 2
        .Left = Target.Offset(0, 1).Left
        .Font.Size = 14
        .List = Sheets("Sheet2").Range("A1:A20").Value
        .Visible = True
        .Value = ""
        .LinkedCell = Target.Address
        .Activate
        .DropDown
        End With
  End If
End Sub

 

[kanadaaa]

Thank you akuini, but the selected value disappears when I click somewhere else.
How can I leave the value in the double-clicked cell?

 

[Akuini]

Thank you akuini, but the selected value disappears when I click somewhere else.

Are you sure you included this part?

Private Sub ComboBox1_LostFocus()
    ComboBox1.Visible = False
    ComboBox1.LinkedCell = ""
End Sub

 

[kanadaaa]

I'm sure I did but it just works like this:
<< unavailable video removed >>

 

[Akuini]

Hm, I'm not sure why that happen, it works for me. Here's an example:
example

But here's another way to try:

Private Sub ComboBox1_Change()
    ActiveCell = ComboBox1.Value
End Sub


Private Sub ComboBox1_LostFocus()
    ComboBox1.Visible = False
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Sheets("Sheet1").Range("A1:A10")) Is Nothing Then
        
 'setting up combobox property
        With ComboBox1
        .Height = Target.Height + 5
        .Width = Target.Width + 30
        .Top = Target.Top - 2
        .Left = Target.Offset(0, 1).Left
        .Font.Size = 14
        .List = Sheets("Sheet2").Range("A1:A20").Value
        .Visible = True
        .Value = ""
        .LinkedCell = ""
        .Activate
        .DropDown
        End With
  End If
End Sub

 

[kanadaaa]

The file on the dropbox didn't work, either.
Maybe this is caused by the difference of the office version.

 

[Akuini]

The file on the dropbox didn't work, either.
Maybe this is caused by the difference of the office version.

Yes, maybe.
What about the second code?

 

[kanadaaa]

Yes, maybe.
What about the second code?

It didn't work either, unfortunately.
It just behaved in the same way as the first code ?
Thank you for your help, anyway.

 

[Yongle]

I also use 365 and experienced same behaviour as @kanadaaa

This minor variation works for me

At TOP of STANDARD module (above all procedures)

Public TargetCell As Range

In sheet module

Private Sub ComboBox1_LostFocus()
    TargetCell = ComboBox1.Value
    ComboBox1.Visible = False
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Sheets("Sheet1").Range("A1:A10")) Is Nothing Then
       
'setting up combobox property
        Set TargetCell = Target
        With ComboBox1
        .Height = Target.Height + 5
        .Width = Target.Width + 30
        .Top = Target.Top - 2
        .Left = Target.Offset(0, 1).Left
        .Font.Size = 14
        .List = Sheets("Sheet2").Range("A1:A20").Value
        .Visible = True
        .Value = ""
        .Activate
        .DropDown
        End With
  End If
End Sub