VBA Code for selected items in listbox displayed in Excel on a row

[VLange]

Hello,

I have been researching how to take the selections from a listbox and have them displayed in specific columns in a worksheet. I found one thread that was helpful, http://www.mrexcel.com/forum/excel-...-applications-code-selected-item-listbox.html that I copied code from. This extracts my selected items but puts all item in the first column, not in the row under the columns.

'At least 1 row selected
Dim I As Long
Dim J As Long
Dim arrItems()
    ReDim arrItems(0 To lbxStatesOfferingUBI.ColumnCount - 1)
    For J = 0 To lbxStatesOfferingUBI.ListCount - 1
        If lbxStatesOfferingUBI.Selected(J) Then


            For I = 0 To lbxStatesOfferingUBI.ColumnCount - 1
                arrItems(I) = lbxStatesOfferingUBI.Column(I, J)
            Next I
            
            With Sheets("Data")
                Cells(.Rows.Count, 43).End(xlUp).Offset(1).Resize(, lbxStatesOfferingUBI.ColumnCount).Value = arrItems
            End With
        End If
    Next J

Here is an example of what my worksheet looks like when I add a new record to the worksheet. My code is putting the status all under column 43, when what I need is for the state to be put under the identified columns, i.e.; AL=43, AZ=45, CA=46, etc. I'd even be happy if instead of having the state abbreviation entered if it put an X but my main goal is to switch the code from a column entry to a row entry.

Column Number = 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 % of Total Vehicles Insured in UBI Program AL AK AZ AR CA CO CT DE FL GA HI ID IL IN IA KS KY LA ME MD MA MI MN MS MO MT NE NV NH NJ NM NY NC ND OH OK OR PA RI SC SD TN TX UT VT VA WA WV WI WY DC AL AZ CA CT FL HI IA LA ME MN MS NY WV WI WY DC <colgroup><col><col><col><col span="6"><col><col span="42"></colgroup><tbody> </tbody>

<tbody>
</tbody>

Thank you!
Valerie

 

[MickG]

Try this for selected lines in List box to be Produced Results Horizontally in sheet "Data" Starting column 43, row 2, under the appropriate Heading.
NB:- Run Code from Listbox sheet.

[COLOR="Navy"]Sub[/COLOR] MG01Aug57
[COLOR="Navy"]Dim[/COLOR] I [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] J [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] arrItems(), Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Data")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A43"), .Cells(1, Columns.Count).End(xlToLeft))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = Dn: [COLOR="Navy"]Next[/COLOR]

   ReDim arrItems(0 To lbxStatesOfferingUBI.ColumnCount - 1)
    [COLOR="Navy"]For[/COLOR] J = 0 To lbxStatesOfferingUBI.ListCount - 1
        [COLOR="Navy"]If[/COLOR] lbxStatesOfferingUBI.Selected(J) [COLOR="Navy"]Then[/COLOR]
               
            [COLOR="Navy"]For[/COLOR] I = 0 To lbxStatesOfferingUBI.ColumnCount - 1
                [COLOR="Navy"]With[/COLOR] lbxStatesOfferingUBI
                   Dic(.Column(I, J)).Offset(1) = .Column(I, J)
                 [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]Next[/COLOR] I
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] J
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[VLange]

Hello Mick,

That worked great, thank you!

Now my issue is I need to have this same function on four other lbx state entries in the code (lbxUBIStates, lbxYDIStates, lbxRCStates and lbxFltStates. I can't copy the exact code you provided and change the lbx names because it gives me an error of 'Duplicate Declaration in current scope' on the Dim I As Long. I had copied the previous code using the I and J from another site so if there is a better option I'm very open to your recommendation.

Also, I don't know if makes a difference with what I'm using for code above this state entry code.

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")


'find first empty row
iRow = ws.Cells.find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'check for a Company Name
If Trim(Me.txtCompanyName.Value) = "" Then
 Me.txtCompanyName.SetFocus
 MsgBox "Please enter a Company Name"
 Exit Sub
End If


'copy the data to the database
ws.Cells(iRow, 2).Value = Me.cboCustomer.Value
ws.Cells(iRow, 3).Value = Me.txtAcctExec.Value


If ckbTer1.Value = True Then
  ws.Cells(iRow, 4).Value = "X"
 Else
   ws.Cells(iRow, 4).Value = ""
End If


If ckbTer2.Value = True Then
  ws.Cells(iRow, 5).Value = "X"
 Else
   ws.Cells(iRow, 5).Value = ""
End If

There is a lot more code after since my userform has 780 fields. If you need more of it let me know.

I am very new to vba so I'm piecing together code to make my userform add the data to my worksheet.

Thanks again for your help and guidance.

Valerie

 

[VLange]

Mick,

I just realized that when I click the add customer button I have set up it is adding any new states I click to the same row, not to a new row for a new customer. Sorry for the extra work, I should have explained I was adding a new customer with my first post.

Thank you,
Valerie

 

[MickG]

I don't really understand what all your code does. Do all these four listboxes transfer values to the same sets of columns( 43 on!!)
and do you want each selection to fill these columns in new rows ??
Would you like me to reproduce this code for 4 Listboxes,and for each LB to fill the same columns but on fresh rows ????

 

[VLange]

Hi Mick,

Sorry for the confusion. The entry would be for a new customer on the same row but into different columns on the sheet. The list box names and ranges are below.

lbxStatesOfferingUBI column range 43-94 - this is the code you provided to me.
lbxUBIStates column range 178-229
lbxYDIStates column range 229-279
lbxRCStates column range 280-330
lbxFltStates column range 331-381

Basically a customer can have different states for each of the five list boxes and all of the information would post on the same row.

Thank you!
Valerie