Add a ListBox.
Propperties of the ListBox:
Add a Button.
Code for the Button:
Propperties of the ListBox:
Add a Button.
Code for the Button:
VBA Code:
Sub Button3_Klikken[] 'Adjust number
Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String, xActivecellStr As String
Set xSelShp = ActiveSheet.Shapes["Button 3"] 'ActiveSheet.Shapes[Application.Caller]
Set xLstBox = ActiveSheet.ListBox1
xActivecellStr = ActiveCell.Address
If xLstBox.Visible = False Then
xLstBox.Visible = True
xSelShp.Select
Selection.Characters.Text = "Save choices"
xStr = ""
xStr = Range[xActivecellStr]
If xStr "" Then
xArr = Split[xStr, ";"]
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List[I]
For J = 0 To UBound[xArr]
If xArr[J] = xV Then
xLstBox.Selected[I] = True
Exit For
End If
Next
Next I
End If
Else
xLstBox.Visible = False
xSelShp.Select
Selection.Characters.Text = "Choice"
For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected[I] = True Then
xSelLst = xLstBox.List[I] & ";" & xSelLst
xLstBox.Selected[I] = False
End If
Next I
If xSelLst "" Then
Range[xActivecellStr] = Mid[xSelLst, 1, Len[xSelLst] - 1]
Else
Range[xActivecellStr] = ""
End If
End If
ActiveSheet.Range[xActivecellStr].Select
End Sub
Thank you,mart37 said:Add a ListBox.
Propperties of the ListBox:
View attachment 29963
Add a Button.
Code for the Button:VBA Code:Sub Button3_Klikken[] 'Adjust number Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer Dim xV As String, xActivecellStr As String Set xSelShp = ActiveSheet.Shapes["Button 3"] 'ActiveSheet.Shapes[Application.Caller] Set xLstBox = ActiveSheet.ListBox1 xActivecellStr = ActiveCell.Address If xLstBox.Visible = False Then xLstBox.Visible = True xSelShp.Select Selection.Characters.Text = "Save choices" xStr = "" xStr = Range[xActivecellStr] If xStr "" Then xArr = Split[xStr, ";"] For I = xLstBox.ListCount - 1 To 0 Step -1 xV = xLstBox.List[I] For J = 0 To UBound[xArr] If xArr[J] = xV Then xLstBox.Selected[I] = True Exit For End If Next Next I End If Else xLstBox.Visible = False xSelShp.Select Selection.Characters.Text = "Choice" For I = xLstBox.ListCount - 1 To 0 Step -1 If xLstBox.Selected[I] = True Then xSelLst = xLstBox.List[I] & ";" & xSelLst xLstBox.Selected[I] = False End If Next I If xSelLst "" Then Range[xActivecellStr] = Mid[xSelLst, 1, Len[xSelLst] - 1] Else Range[xActivecellStr] = "" End If End If ActiveSheet.Range[xActivecellStr].Select End SubClick to expand...
Until the button all is ok, after not getting it. Can you please give m the final example how it looks?