PDA

View Full Version : [SOLVED] Selected listbox items to worksheet not working



tlchan
01-17-2015, 07:26 PM
Hi there

Friend of mine help me to accomplish task to copy selected listbox items to a worksheet to form a listing of items to be sent to the centre. However it seems the vba not working as intended. I wish the VBA expert to assist how to work around this VBA.


Workbook attached

pike
01-17-2015, 09:32 PM
Hi tlchan (http://www.vbaexpress.com/forum/member.php?12499-tlchan)
This is the problem sourcerow=sheet1!A2:I30
delete the Source Row value and load the list box in Initialize

also made some changes to the to the "cmd_AddtoList_Click" sub

Option Explicit
Private Sub UserForm_Initialize()
Dim a
a = Worksheets("Sheet1").Range("A2:I30").Value
Me.Lb_AAlist.List = a
End Sub
Private Sub cmd_AddtoList_Click()
Dim lItem As Long, lRows As Long, lCols As Long
Dim bSelected As Boolean
Dim lColLoop As Long, lTransferRow As Long
'Pass row & column count to variables
'Less 1 as "Count" starts at zero
Application.ScreenUpdating = True

lRows = Lb_AAlist.ListCount - 1
lCols = Lb_AAlist.ColumnCount - 1


Sheet3.Range("B30:D39").ClearContents

'Ensure they have at least 1 row selected
For lItem = 0 To lRows
'At least 1 row selected
If Me.Lb_AAlist.Selected(lItem) Then
'Boolean flag
bSelected = True
'Exit for loop
' Exit For
End If
Next

'At least 1 row selected
If bSelected Then
With Worksheets("Sheet3") 'Transfer to range
.Range("B30", .Cells(lRows + 2, 1 + lCols)).ClearContents 'Clear transfer range

For lItem = 0 To lRows
If Me.Lb_AAlist.Selected(lItem) Then 'Row selected

'Increment variable for row transfer range
lTransferRow = lTransferRow + 1
'Loop through columns of selected row
'For lColLoop = 0 To lCols
'Transfer selected row to relevant row of transfer range

.Cells(lTransferRow + 29, 2) = Me.Lb_AAlist.List(lItem, 0)
.Cells(lTransferRow + 29, 3) = Me.Lb_AAlist.List(lItem, 1)
.Cells(lTransferRow + 29, 4) = Me.Lb_AAlist.List(lItem, 8)
'Uncheck selected row
' Lb_AAlist.Selected(lItem) = False

'Next lColLoop
End If
Next

End With

'Else ' NO listbox row chosen
'MsgBox "Nothing chosen", vbCritical

End If
With Sheet3
.Range("A42").Value = "Kindly acknowledge receipt by signing and returning to us the duplicate of this memorandum."
.Range("A49").Value = "Colin John(055403)"
.Range("A50").Value = "Sales Support Executive"
End With
Application.ScreenUpdating = False

End Sub

tlchan
01-18-2015, 12:02 AM
Thanks Pike for your marvelous solution.

In the meantime is there any way numbering according to the number of selected items instead of manually edited in sheet 3?

Wish to trouble you again.

pike
01-18-2015, 12:12 AM
no trouble, thanks for posting at VBAX


Option Explicit
Private Sub UserForm_Initialize()
Dim a
a = Worksheets("Sheet1").Range("A2:I" & Cells(Rows.Count, 1).End(xlUp).Row).Value
Me.Lb_AAlist.List = a
End Sub
Private Sub cmd_AddtoList_Click()
Dim lItem As Long, lRows As Long, lCols As Long
Dim bSelected As Boolean
Dim lColLoop As Long, lTransferRow As Long
'Pass row & column count to variables
'Less 1 as "Count" starts at zero
Application.ScreenUpdating = True
lRows = Me.Lb_AAlist.ListCount - 1
lCols = Me.Lb_AAlist.ColumnCount - 1

Sheet3.Range("A30:D39").ClearContents
'Ensure they have at least 1 row selected
For lItem = 0 To lRows
'At least 1 row selected
If Me.Lb_AAlist.Selected(lItem) Then
'Boolean flag
bSelected = True
'Exit for loop
Exit For
End If
Next
'At least 1 row selected
If bSelected Then
With Sheet3
'Transfer to range
.Range("B30", Cells(lRows + 2, 1 + lCols)).ClearContents
'Clear transfer range
For lItem = 0 To lRows
If Me.Lb_AAlist.Selected(lItem) Then 'Row selected
'Increment variable for row transfer range
lTransferRow = lTransferRow + 1
'Loop through columns of selected row
'For lColLoop = 0 To lCols
'Transfer selected row to relevant row of transfer range
.Cells(lTransferRow + 29, 1) = lTransferRow
.Cells(lTransferRow + 29, 2) = Me.Lb_AAlist.List(lItem, 0)
.Cells(lTransferRow + 29, 3) = Me.Lb_AAlist.List(lItem, 1)
.Cells(lTransferRow + 29, 4) = Me.Lb_AAlist.List(lItem, 8)
'Uncheck selected row
Me.Lb_AAlist.Selected(lItem) = False

End If
'Next lColLoop
Next
End With
Else ' NO listbox row chosen
MsgBox "Nothing chosen", vbCritical
End If
With Sheet3
.Range("A42").Value = "Kindly acknowledge receipt by signing and returning to us the duplicate of this memorandum."
.Range("A49").Value = "Colin John(055403)"
.Range("A50").Value = "Sales Support Executive"
End With
Application.ScreenUpdating = False
End Sub

SamT
01-18-2015, 04:59 AM
Use thread tools to mark it solved, please

tlchan
01-18-2015, 05:45 AM
Hi pike

Thanks again for the prompt assistance.