Execute a code for ONLY the first change event-CodePudding

Okay, so I have a sheet where when any cell in the range C9:C209 is selected, a listbox pops up and allows the user to select numbers (they refer to a count of a criteria in the corresponding line in the cell to its right). Some of the features that must be maintained are:

(1) The numbers must appear in the cell in the order they are selected.

(2) The user must be able to select and deselect items in the listbox without the previous selections being deleted.

(3) For some unknown reason I seem to need to maintain some form of oTarget2.ClearContents within the Private Sub Lbx2_Change() event or else the active cell will not change to the sequential cell when the user hits enter...which is why I have the strange rememberME code inserted into the change event.

(4) If the selected cell already has numbers in it I'd like them to be deleted, but only AFTER the user has decided to click a selection in the listbox. Currently it deletes the contents as soon as the cell is selected, and if I set it to delete upon a selection being present, it will delete the entire cell contents as soon as each selection is made which means the user can only select one item.

Is it possible to execute a specific code only upon the FIRST change event in a Private Sub ListBox_Change() event?

See my code below:

Option Explicit
 
Private WithEvents Lbx2 As MSForms.ListBox
Private oTarget2 As Range
Private ListBoxName2 As String
Private Const Range_2 As String = "C9:C209"
Private Const WIDTH2_1 As String = "C9" '"WIDTH2"
Private Const WIDTH2_2 As String = "B9"
Private iClickedItem As Long
Private rememberME As String

Private Sub Lbx2_Change()
    
    Dim k As Long
    
    If Len(oTarget2) = 0 Then
        rememberME = ""
        Else
            rememberME = oTarget2
    End If
    
    oTarget2.ClearContents
    
    For k = 0 To Lbx2.ListCount - 1
        If Lbx2.ListIndex <> -1 Then
            If Lbx2.Selected(k) Then
                If Len(rememberME) = 0 Then 'rememberME for oTarget2
                    oTarget2 = Lbx2.List(k)
                Else
                    oTarget2 = Trim(rememberME & vbNewLine & Lbx2.List(k)) 'rememberME for oTarget2
                End If
            End If
        Else
            oTarget2 = rememberME
        End If
    Next
    
    
End Sub
    
Private Sub Lbx2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    iClickedItem = Lbx2.ListIndex 'Get index of clicked item in ListBox
End Sub

Private Sub Lbx2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Lbx2.ListIndex = iClickedItem Then   'If clicked item is selected, de-select it
        Lbx2.ListIndex = -1
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    ActiveWindow.Zoom = 100    

    Dim WIDTHLB2_1 As Variant: WIDTHLB2_1 = Range(WIDTH2_1).Left
    Dim WIDTHLB2_2 As Variant: WIDTHLB2_2 = Range(WIDTH2_2).Left
    Dim WIDTHLB2 As Integer: WIDTHLB2 = WIDTHLB2_1 - WIDTHLB2_2
    
    Dim oListBox2 As OLEObject

    On Error Resume Next
    Me.OLEObjects(1).Delete
    
    Range(Range_2).Interior.ColorIndex = 0
    
    If Target.Column = 3 And (Target.Row >= 9 And Target.Row <= 209) Then
    'UCase(Target.Address(0, 0)) = UCase(Range_2)
        Application.DisplayFormulaBar = False
        Set oListBox2 = _
        Me.OLEObjects.Add(ClassType:="Forms.ListBox.1")
        With oListBox2
             Names.Add "ListBoxName2", .Name
            .Left = WIDTHLB2_1 - ((WIDTHLB2 / 2.5)   1)
            .Top = Target.Offset(0, 0).Top
            .Object.ColumnCount = 1
            .Object.ColumnWidths = "10"
            .WIDTH = WIDTHLB2 / 2.5
            .Height = Me.StandardHeight * 17.5
            .Object.ListStyle = fmListStylePlain
            .ListFillRange = "DI1:DI20"
            .Placement = xlFreeFloating
            .Object.MultiSelect = fmMultiSelectSingle
            .Object.SpecialEffect = fmSpecialEffectFlat
            .Object.BorderStyle = fmBorderStyleSingle
            .Object.TextAlign = fmTextAlignRight
            With Application
                .OnTime Now   _
                TimeSerial(0, 0, 0.01), Me.CodeName & ".HookListBox2"
                .CommandBars.FindControl(ID:=1605).Execute
            End With
        End With
    Else
        Application.DisplayFormulaBar = True
        Names("ListBoxName2").Delete
        Range(Range_2).Interior.ColorIndex = 0
    End If
    
 
End Sub
 
Private Sub HookListBox2()
 
    Application.CommandBars.FindControl(ID:=1605).Reset
    Set oTarget2 = ActiveCell
    ActiveCell.Interior.Color = vbYellow
    'display the listbox and hook it.
    With Me.OLEObjects(Evaluate("ListBoxName2"))
        .Visible = True
        Set Lbx2 = .Object
    End With
    oTarget2.ClearContents
End Sub

CodePudding user response：

add a boolean to the header

bNewCell as boolean

modify the sub Lbx2_Change() as

    If Lbx2.ListIndex < 0 Then Exit Sub
    Dim k As Long

    k = Lbx2.ListIndex
    If bNewCell Then
            oTarget2.Value = ""
            bNewCell = False
    End If
    If oTarget2.Value = "" Then
            oTarget2 = Lbx2.List(k)
    Else
            oTarget2 = oTarget2 & vbNewLine & Lbx2.List(k)
    End If

modify the HookListBox2() to replace the otarget2.clearContents with bNewCell = true

remove the Mouse Down and Mouse Up events. Remove the rememberMe and iclickedItem

CodePudding user response：

Here's the code that ended up working (I'm sure there's a prettier way, but this got the job done):


Private Sub Lbx2_Change()
    
    Dim k As Long
    
    If Len(oTarget2_FIRST) = 0 Then
        
        If Len(oTarget2) = 0 Then
            rememberME = ""
        Else
            rememberME = oTarget2
        End If
        
        oTarget2.ClearContents
        
        For k = 0 To Lbx2.ListCount - 1
            If Lbx2.ListIndex <> -1 Then
                If Lbx2.Selected(k) Then
                    If Len(rememberME) = 0 Then 'rememberME for oTarget2
                        oTarget2 = Lbx2.List(k)
                    Else
                        oTarget2 = Trim(rememberME & vbNewLine & Lbx2.List(k)) 'rememberME for oTarget2
                    End If
                End If
            Else
                oTarget2 = rememberME
            End If
        Next
        
    Else
        
        If oTarget2_MARKER = 0 Then
            oTarget2.ClearContents
            oTarget2_MARKER = oTarget2_MARKER   1
            If Len(oTarget2) = 0 Then
            rememberME = ""
            Else
            rememberME = oTarget2
            End If
        
            oTarget2.ClearContents
        
            For k = 0 To Lbx2.ListCount - 1
                If Lbx2.ListIndex <> -1 Then
                    If Lbx2.Selected(k) Then
                        If Len(rememberME) = 0 Then 'rememberME for oTarget2
                            oTarget2 = Lbx2.List(k)
                        Else
                            oTarget2 = Trim(rememberME & vbNewLine & Lbx2.List(k)) 'rememberME for oTarget2
                        End If
                    End If
                Else
                    oTarget2 = rememberME
                End If
            Next

        Else
            If Len(oTarget2) = 0 Then
            rememberME = ""
            Else
            rememberME = oTarget2
            End If
        
            oTarget2.ClearContents
        
            For k = 0 To Lbx2.ListCount - 1
                If Lbx2.ListIndex <> -1 Then
                    If Lbx2.Selected(k) Then
                        If Len(rememberME) = 0 Then 'rememberME for oTarget2
                            oTarget2 = Lbx2.List(k)
                        Else
                            oTarget2 = Trim(rememberME & vbNewLine & Lbx2.List(k)) 'rememberME for oTarget2
                        End If
                    End If
                Else
                    oTarget2 = rememberME
                End If
            Next
        End If
        
    End If
    
End Sub
    
Private Sub Lbx2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    iClickedItem = Lbx2.ListIndex 'Get index of clicked item in ListBox

End Sub

Private Sub Lbx2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Lbx2.ListIndex = iClickedItem Then   'If clicked item is selected, de-select it
        Lbx2.ListIndex = -1
    End If

End Sub