Excel vba - specify bound column 2 in List Box

Hello.  I have this handy piece of code which allows me to multi-select values in a list box, and those multiple values store in a cell as a comma separated string.

The problem is this only seems to work assuming the column you want bound is the same column that the list box shows (in this case column 1).  How can I get this code to work if I want the column 1 to show in the list box, but column 2 bound with the list of comma separated values?
Sub ListBox1_LostFocus()
  Dim s As String, i As Integer

  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then s = s & .List(i) & ","
    Next i
  End With
  
  With Range("A1")
    If s = vbNullString Then
      .Value = vbNullString
      Exit Sub
      Else
      .Value = Left(s, Len(s) - 1)
    End If
    On Error Resume Next
    '.Comment.Delete
    '.AddComment .Value
  End With
  
End Sub

Open in new window


Attached is an Excel file containing the code, list box, and named column range.
Multi-Select-in-Excel-List-Box.xlsm
jobprojnAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Just add a second parameter to the .List

Sub ListBox1_LostFocus()
  Dim s As String, i As Integer

  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then s = s & .List(i, 1) & ","     'Note the .List(i,1)
    Next i
  End With
  
  With Range("A1")
    If s = vbNullString Then
      .Value = vbNullString
      Exit Sub
      Else
      .Value = Left(s, Len(s) - 1)
    End If
    On Error Resume Next
    '.Comment.Delete
    '.AddComment .Value
  End With
  
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jobprojnAuthor Commented:
Worked like a charm.  Thanks!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.