I have a multi Select Listbox (with a lot of forum help)
It works GREAT - now I am thinking, there are rows where column B and column C are empty - If that is the case, even if they are selected - do not tranfer to Entry Sheet
This is current code:
Private Sub CmdAdd_Click()
Dim ws As Worksheet
Dim arrColB(1 To 65000) As Variant
Dim arrColD(1 To 65000) As Variant
Dim arrColE(1 To 65000) As Variant
Dim arrColF(1 To 65000) As Variant
Dim arrColI(1 To 65000) As Variant
Dim arrQty(1 To 65000) As Variant
Dim arrPromo(1 To 65000) As Variant
Dim i As Long
Dim DataIndex As Long
Dim lRow As Long
Set ws = Sheets("Entry")
lRow = ws.Cells(Rows.Count, "D").End(xlUp).Offset(1).Row
If Trim(Me.TxtQty.Value) = "" Then
Me.TxtQty.SetFocus
MsgBox "Please add a quantity"
Exit Sub
End If
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
DataIndex = DataIndex + 1
arrColB(DataIndex) = .List(i, 0)
arrColE(DataIndex) = .List(i, 1)
arrColF(DataIndex) = .List(i, 2)
arrColD(DataIndex) = .List(i, 3)
arrColI(DataIndex) = .List(i, 4)
arrQty(DataIndex) = Me.TxtQty.Text
arrPromo(DataIndex) = Me.CboPromoStandard.Text
End If
Next i
End With
If DataIndex > 0 Then
ws.Cells(lRow, "B").Resize(DataIndex).Value = Application.Transpose(arrColB)
ws.Cells(lRow, "D").Resize(DataIndex).Value = Application.Transpose(arrColD)
ws.Cells(lRow, "E").Resize(DataIndex).Value = Application.Transpose(arrColE)
ws.Cells(lRow, "F").Resize(DataIndex).Value = Application.Transpose(arrColF)
ws.Cells(lRow, "I").Resize(DataIndex).Value = Application.Transpose(arrColI)
ws.Cells(lRow, "C").Resize(DataIndex).Value = Application.Transpose(arrQty)
ws.Cells(lRow, "A").Resize(DataIndex).Value = Application.Transpose(arrPromo)
Else
MsgBox "Nothing selected", vbCritical
End If
Set ws = Nothing
Erase arrColB
Erase arrColD
Erase arrColE
Erase arrColF
Erase arrColI
Me.TxtQty.Value = ""
End Sub
Bookmarks