Multi Selection Checkbox Query

[Chewyhairball]

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.

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

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:

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:

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