VBA TIPS
Increase the visible list rows of the Data Validation list

The other day, I was asked that how to increase the visible rows of the Data Validation list?
Normally the visible list count in the Data Validation list is 8.

As far as I know, there is no way to increase the visible rows more than eight. (have a look at the picture in the left)

But a great idea just flashed in my mind. All it takes is using a DropDown Control instead of a Data Validation. (have a look at the picture in the right)

Excel has an object named DropDown as a hidden object (It's for Excel97 and the earlier version.) When you select a cell with Data Validation, this program wiould add a DropDown control dynamically then you can use the added DropDown instead of the Data Validation.

Data Validation DropDown Control




Example

Place the following in the ThisWorkbook module.



Download

You can download the sample workbook from here. sample_070.zip  | downloaded  time(s)

Option Explicit

Dim oDpd As Object
Dim sFml1
Dim prvTarget As Range


Private Sub Workbook_SheetSelectionChange(ByVal Sh As ObjectByVal Target As Range)
    Const dFixedPos As Double = "0.8"
    Const dFixWidth As Double = "12.0"    'Change here to change WIDTH of the DropDown
    Dim vld As Validation
    Dim lDpdLine As Long

    If Not prvTarget Is Nothing Then
        If Not oDpd Is Nothing Then
            If oDpd.Value = 0 Then
                prvTarget.Value = vbNullString
            Else
                prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
            End If
            Set prvTarget = Nothing
        End If
    End If

    On Error Resume Next
    oDpd.Delete
    sFml1 = vbNullString
    Set oDpd = Nothing
    On Error GoTo 0

    If Target.Count > 1 Then
        Set oDpd = Nothing
        Exit Sub
    End If

    Set vld = Target.Validation
    On Error GoTo Terminate
    sFml1 = vld.Formula1
    On Error GoTo 0

    Set prvTarget = Target

    lDpdLine = Range(Mid(sFml1, 2)).Rows.Count

    With Target
        Set oDpd = ActiveSheet.DropDowns.Add( _
                                             .Left - dFixedPos, _
                                             .Top - dFixedPos, _
                                             .Width + dFixWidth + dFixedPos * 2, _
                                             .Height + dFixedPos * 2)
    End With
    With oDpd
        .ListFillRange = sFml1
        .DropDownLines = lDpdLine
        .Display3DShading = True
    End With
Terminate:
End Sub

| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
ABOUT
WORKS
THE CELL MASTERS
CONTACT
LINKS
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo