Guest User

Untitled

a guest
Nov 21st, 2017
72
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 0.87 KB | None | 0 0
  1. Dim lngItem As Long
  2. Const strSep = ", " 'delimiter
  3.  
  4. Private Sub UserForm_Initialize()
  5. With ListBox1
  6. .RowSource = "=Sheet1!A2:A12"
  7. For lngItem = 0 To ListBox1.ListCount - 1
  8. .Selected(lngItem) = InStr(1, strSep & ActiveCell.Value & strSep, strSep & .List(lngItem, 0) & strSep)
  9. Next lngItem
  10. End With
  11. End Sub
  12.  
  13. Private Sub CommandButton1_Click()
  14. Dim strItems As String
  15. With ListBox1
  16. For lngItem = 0 To ListBox1.ListCount - 1
  17. If ListBox1.Selected(lngItem) Then
  18. strItems = strItems & strSep & ListBox1.List(lngItem, 0)
  19. End If
  20. Next lngItem
  21. End With
  22. With ActiveCell
  23. .NumberFormat = "@"
  24. .Value = Replace(strItems, strSep, "", 1, 1)
  25. End With
  26. Unload Me
  27. End Sub
  28.  
  29. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  30. If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub
  31. UserForm1.Show
  32. Cancel = True
  33. End Sub
Add Comment
Please, Sign In to add comment