Multi Selection Checkbox Query

Chewyhairball

Board Regular
Joined
Nov 30, 2017
Messages
97
Hi
I have a form and VBA that creates a multi selection checkbox. It activates when select a cell in a specific column and inputs the data into the cell selected.
1607091297441.png

It works great but I was wondering if there is a way to have it activate on maybe a double click or using the dropdown list button
1607091432745.png


The reason i want to do this is to allow copying or cell drag down when required and the appearance of the multi selection form is going to confuse people every time a cell is selected.

This is the code from the specific sheet:
VBA Code:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String

On Error Resume Next
Application.EnableEvents = False

   Set rngDV = Range("A:A").Cells.SpecialCells(xlCellTypeAllValidation)
   On Error GoTo exitHandler

   If rngDV Is Nothing Then GoTo exitHandler
 
   If Not Intersect(Target, rngDV) Is Nothing Then
      If Target.Validation.Type = 3 Then
       
         strList = Target.Validation.Formula1
         strList = Right(strList, Len(strList) - 1)
         strDVList = strList
       
frmDVList.Left = ActiveCell.Left
frmDVList.Top = ActiveCell.Top
       
         frmDVList.Show
      End If
   End If

exitHandler:
  Application.EnableEvents = True

End Sub

This is the code from the user form:



VBA Code:
Option Explicit



Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmddelete_Click()
  ActiveCell.ClearContents
End Sub

Private Sub cmdOK_Click()

ActiveCell.ClearContents

Dim strSelItems As String
Dim lCountList As Long
Dim strSep As String
Dim strAdd As String
Dim bDup As Boolean

On Error Resume Next
strSep = ", "

With Me.lstDV
   For lCountList = 0 To .ListCount - 1
    
      If .Selected(lCountList) Then
         strAdd = .List(lCountList)
      Else
         strAdd = ""
      End If
    
      If strSelItems = "" Then
         strSelItems = strAdd
      Else
         If strAdd <> "" Then
            strSelItems = strSelItems & strSep & strAdd
         End If
      End If
 
   Next lCountList
End With

With ActiveCell
   If .Value <> "" Then
      .Value = ActiveCell.Value & strSep & strSelItems
   Else
      .Value = strSelItems
   End If
End With



Dim c As Range
For Each c In Selection
    c.ClearComments
    If Len(c.Value) > 0 Then
        c.AddComment
        c.Comment.Shape.TextFrame.AutoSize = True
        c.Comment.Text c.Value & ""
    End If
 
    Next c



Unload Me

End Sub


Private Sub lstDV_Click()

End Sub

Private Sub UserForm_Initialize()
Me.lstDV.RowSource = strDVList

End Sub

as always thanks in advance

Rory
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Watch MrExcel Video

Forum statistics

Threads
1,127,104
Messages
5,622,753
Members
415,926
Latest member
jerrynababa

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
Top