Autofill ComboBox/Data Validation does not work for numbers

R

Rumpkin

Board Regular
Joined
Sep 24, 2016
Messages
75
Office Version
  1. 2019
Platform
  1. Windows
Hello,
I am using an Autofill Code for in a a dropdown list.
I have formulas in other cells that are dependent on the drop down cell entry and work when the Autofill Code and Combobox are removed.
The code works fine if the entry is alphanumeric but will not work if the entry is only numeric. Below is the code:
[TABLE="width: 80"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/TD]
[/TR]
[TR]
[TD] Dim xCombox As OLEObject[/TD]
[/TR]
[TR]
[TD] Dim xStr As String[/TD]
[/TR]
[TR]
[TD] Dim xWs As Worksheet[/TD]
[/TR]
[TR]
[TD] Set xWs = Application.ActiveSheet[/TD]
[/TR]
[TR]
[TD] On Error Resume Next[/TD]
[/TR]
[TR]
[TD] Set xCombox = xWs.OLEObjects("OperCombo")[/TD]
[/TR]
[TR]
[TD] With xCombox[/TD]
[/TR]
[TR]
[TD] .ListFillRange = ""[/TD]
[/TR]
[TR]
[TD] .LinkedCell = ""[/TD]
[/TR]
[TR]
[TD] .Visible = False[/TD]
[/TR]
[TR]
[TD] End With[/TD]
[/TR]
[TR]
[TD] If Target.Validation.Type = 3 Then[/TD]
[/TR]
[TR]
[TD] Target.Validation.InCellDropdown = False
[/TD]
[/TR]
[TR]
[TD] Cancel = True[/TD]
[/TR]
[TR]
[TD] xStr = Target.Validation.Formula1[/TD]
[/TR]
[TR]
[TD] xStr = Right(xStr, Len(xStr) - 1)[/TD]
[/TR]
[TR]
[TD] If xStr = "" Then Exit Sub[/TD]
[/TR]
[TR]
[TD] With xCombox[/TD]
[/TR]
[TR]
[TD] .Visible = True[/TD]
[/TR]
[TR]
[TD] .Left = Target.Left[/TD]
[/TR]
[TR]
[TD] .Top = Target.Top[/TD]
[/TR]
[TR]
[TD] .Width = Target.Width + 5[/TD]
[/TR]
[TR]
[TD] .Height = Target.Height + 5[/TD]
[/TR]
[TR]
[TD] .ListFillRange = xStr[/TD]
[/TR]
[TR]
[TD] .LinkedCell = Target.Address[/TD]
[/TR]
[TR]
[TD] End With[/TD]
[/TR]
[TR]
[TD] xCombox.Activate[/TD]
[/TR]
[TR]
[TD] Me.OperCombo.DropDown[/TD]
[/TR]
[TR]
[TD] End If[/TD]
[/TR]
[TR]
[TD]End Sub[/TD]
[/TR]
[TR]
[TD]Private Sub OperCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)[/TD]
[/TR]
[TR]
[TD] Select Case KeyCode[/TD]
[/TR]
[TR]
[TD] Case 9[/TD]
[/TR]
[TR]
[TD] Application.ActiveCell.Offset(0, 1).Activate[/TD]
[/TR]
[TR]
[TD] Case 13[/TD]
[/TR]
[TR]
[TD] Application.ActiveCell.Offset(1, 0).Activate
[/TD]
[/TR]
[TR]
[TD] Case 37[/TD]
[/TR]
[TR]
[TD] Application.ActiveCell.Offset(0, -1).Activate[/TD]
[/TR]
[TR]
[TD] Case 39[/TD]
[/TR]
[TR]
[TD] Application.ActiveCell.Offset(0, 1).Activate[/TD]
[/TR]
[TR]
[TD] Case 16, 9[/TD]
[/TR]
[TR]
[TD] Application.ActiveCell.Offset(0, -1).Activate[/TD]
[/TR]
[TR]
[TD] End Select[/TD]
[/TR]
[TR]
[TD]End Sub[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
I don't know the answer, but do yourself a favor and post readable code. That will make people who know more likely to stop and take the time to provide a solution. :)

Here's your code, unchanged but formatted and properly indented. I hope someone posts a solution for you.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    
    Set xWs = Application.ActiveSheet
    
    On Error Resume Next
    
    Set xCombox = xWs.OLEObjects("OperCombo")
    
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        
        If xStr = "" Then Exit Sub
        
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            .LinkedCell = Target.Address
        End With
        
        xCombox.Activate
        Me.OperCombo.DropDown
    
    End If
    
End Sub
[HR][/HR]
Private Sub OperCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Select Case KeyCode
    Case 9
        Application.ActiveCell.Offset(0, 1).Activate
    Case 13
        Application.ActiveCell.Offset(1, 0).Activate
    Case 37
        Application.ActiveCell.Offset(0, -1).Activate
    Case 39
        Application.ActiveCell.Offset(0, 1).Activate
    Case 16, 9
        Application.ActiveCell.Offset(0, -1).Activate
    End Select
    
End Sub
 
Upvote 0
Thanks,
I do not know how to post it other copy it in to the body of the email
Will you tell me how? I am running another worksheet routine so I wonder if that would interfere.
 
Upvote 0
Thanks. here is the corrected code in the correct format.
Code: 
Private Sub OperCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
Dim varVal As Variant
On Error Resume Next
varVal = --ActiveCell.Value
If IsEmpty(varVal) Then
  varVal = ActiveCell.Value
End If

Select Case KeyCode
  Case 9  'tab
    ActiveCell.Value = varVal
    ActiveCell.Offset(0, 1).Activate
  Case 13 'enter
    ActiveCell.Value = varVal
    ActiveCell.Offset(1, 0).Activate
  Case 37
    Application.ActiveCell.Offset(0, -1).Activate
  Case 39
    Application.ActiveCell.Offset(0, 1).Activate
  Case 16, 9
    Application.ActiveCell.Offset(0, -1).Activate
  Case Else
    'do nothing
End Select
End Sub
Private Sub OperCombo_LostFocus()
  With Me.OperCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("OperCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.OperCombo.DropDown
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
protecting a Macro sub
Replies
9
Views
612
Tej92
T
A
  • Question Question
Limit VBA code to a range of cells.
Replies
1
Views
483
mumps
mumps
D
  • Question Question
Hello...help in modifying the code to search in all letters
Replies
1
Views
524
Dayski147
D
M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
469
MagicCarpet
M
M
  • Question Question
Not running code
Replies
0
Views
191
MagicCarpet
M

Forum statistics

Threads
1,223,270
Messages
6,171,103
Members
452,379
Latest member
IainTru

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