Mehrspaltige Combo- bzw. Listbox

Private Sub UserForm_Initialize()
'ini_tab_Product_Schedule
Dim index, index2, index3, index4
Dim intZeile As Integer
Dim tmp, datediff
'read in dates
cboProductSchSelectDate.ColumnWidths = ("2,5cm;2cm")
datediff = CDate(Sheet13.txtEDI.Value) - CDate(Sheet13.txtSDI.Value)
For index = 0 To datediff
With cboProductSchSelectDate
.AddItem
.List(index, 0) = Format(CDate(Sheet13.txtSDI.Value) + index, "dd/mm/yyyy")
.List(index, 1) = ""
End With
Next index
'not saved
If tab_Product_Schedule_saved = False Then
'init of array all 0
For index = 0 To UBound(data_productSchedule, 1)
For index2 = 0 To UBound(data_productSchedule, 2)
data_productSchedule(index, index2) = 0
Next index2
Next index
'fill array with data from input table
index = 0
While Sheet4.Cells(5 + index, "D").Value  ""
'determine corresponding listindex of date
index3 = 0
For index2 = 0 To cboProductSchSelectDate.ListCount - 1
If cboProductSchSelectDate.List(index2) = Format(Sheet4.Cells(5 + index, "D").  _
_
Value, "dd/mm/yyyy") Then
While data_productSchedule(index2 * 3, index3)  0
index3 = index3 + 1
Wend
data_productSchedule(index2 * 3, index3) = Sheet4.Cells(5 + index, "F"). _
Value
data_productSchedule(index2 * 3 + 1, index3) = Sheet4.Cells(5 + index, "G"). _
_
Value
Exit For
End If
Next index2
index = index + 1
Wend
'saved
Else
'fill array with data from output table
index = 0
index3 = 0
While Sheet9.Cells(2 + index, "C").Value  ""
For index2 = 3 To 25
data_productSchedule(index3, index2 - 3) = Sheet9.Cells(index + 2, index2). _
Value
data_productSchedule(index3 + 1, index2 - 3) = Sheet9.Cells(index + 2 + 1,  _
index2).Value
data_productSchedule(index3 + 2, index2 - 3) = 0
Next index2
index = index + 2
index3 = index3 + 3
Wend
'replace IDs with name of product groups in array
'determine number of product groups
index4 = 0
While Sheet4.Cells(5 + index4, "EL").Value  ""
index4 = index4 + 1
Wend
For index = 0 To UBound(data_productSchedule, 1) Step 3
For index2 = 0 To UBound(data_productSchedule, 2)
For index3 = 0 To index4 - 1
If data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EK"). _
Value Then
data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EL"). _
Value
End If
Next index3
Next index2
Next index
End If
'read in order sequences
lstProductSchSequence.ColumnWidths = ("0,7cm;0,8cm")
index = 0
While Sheet4.Cells(5 + index, "B").Value  ""
lstProductSchSequence.AddItem (Sheet4.Cells(5 + index, "B").Value)
index = index + 1
Wend
lstProductSchSequence.ListIndex = 0
lstProductSchSequence.Enabled = False
'read in product groups
index = 0
While Sheet4.Cells(5 + index, "EL").Value  ""
lstProductSchProductGroup.AddItem (Sheet4.Cells(5 + index, "EL").Value)
index = index + 1
Wend
lstProductSchProductGroup.ListIndex = -1
'search corresponding product group if value in array  0
If data_productSchedule(0, 0)  0 Then
For index = 0 To lstProductSchProductGroup.ListCount - 1
'determine corresponding listindex of product group
If lstProductSchProductGroup.List(index) = Sheet4.Cells(5, "F").Value Then
lstProductSchProductGroup.ListIndex = index
Exit For
End If
Next index
End If
'set textbox quantity
txtProductSchQuantity.Value = data_productSchedule(1, 0)
'set combobox date
cboProductSchSelectDate.ListIndex = 0
cmdProductSchProductGroupDeleteSelection.Visible = False
End Sub

Private Sub UserForm_Activate()
Set moResizer.form = Me
With Me
'This will create a vertical scrollbar
.ScrollBars = fmScrollBarsBoth
'Change the values of 2 as Per your requirements
.ScrollHeight = .Height - 45
.ScrollWidth = .Width - 35
End With
End Sub

Private Sub UserForm_Resize()
moResizer.FormResize
End Sub

Private Sub txtProductSchQuantity_AfterUpdate()
spnProductSchQuantity.Enabled = True
End Sub

Private Sub txtProductSchQuantity_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
spnProductSchQuantity.Enabled = False
Select Case KeyAscii
Case 48 To 57 ' Ascii-Code für Zahlen von 0-9
Case Else
KeyAscii = 0
Beep
End Select
End Sub

Private Sub spnProductSchQuantity_SpinDown()
If CLng(txtProductSchQuantity.Value) - 1 = 0 are possible. ", vbInformation, "Value out of range."
Exit Sub
Else
txtProductSchQuantity.Value = CLng(txtProductSchQuantity.Value) - 1
End If
End Sub

Private Sub spnProductSchQuantity_SpinUp()
txtProductSchQuantity.Value = CLng(txtProductSchQuantity.Value) + 1
End Sub

Private Sub cmdProductSchProductGroupDeleteSelection_Click()
lstProductSchProductGroup.ListIndex = -1
cmdProductSchProductGroupDeleteSelection.Visible = False
End Sub

Private Sub lstProductSchProductGroup_Click()
'ttt
If cboProductSchSelectDate.ListIndex > -1 And lstProductSchSequence.ListIndex > -1 Then
If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence. _
ListIndex) = 0 And data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1,  _
lstProductSchSequence.ListIndex) = 0 Then cmdProductSchProductGroupDeleteSelection.Visible = True
End If
End Sub

Private Sub cmdProductSchAssignSequence_Click()
Dim index As Integer
Dim modified As Boolean
modified = False
'check complete assignment
If lstProductSchProductGroup.ListIndex > -1 And txtProductSchQuantity.Value = 0 Then
MsgBox "Product Group without Quantity is not possible!", vbCritical + vbOKOnly, " _
Quantity for selected Product Group missing"
Exit Sub
End If
If lstProductSchProductGroup.ListIndex  0 Then
MsgBox "Quantity without selection of Product Group is not possible!", vbCritical +  _
vbOKOnly, "Assigned Product Group for Quantity is missing"
Exit Sub
End If
If lstProductSchProductGroup.ListIndex  data_productSchedule(cboProductSchSelectDate. _
ListIndex * 3 + 1, lstProductSchSequence.ListIndex) Then
data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, lstProductSchSequence.  _
_
ListIndex) = txtProductSchQuantity.Value
modified = True
End If
If lstProductSchProductGroup.ListIndex > -1 Then
If lstProductSchProductGroup.List(lstProductSchProductGroup.ListIndex)   _
data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence.ListIndex)  _
Then
data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence.  _
_
ListIndex) = lstProductSchProductGroup.List(lstProductSchProductGroup.ListIndex)
modified = True
End If
End If
If modified = True Then
cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = "modified"
Else
cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = "assigned"
End If
'update of userform
lstProductSchSequence.List(lstProductSchSequence.ListIndex, 1) = "assigned"
'store assigned information in array
data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, lstProductSchSequence. _
ListIndex) = 1
If lstProductSchSequence.ListIndex  0
If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence. _
ListIndex)  0 Then
For index = 0 To lstProductSchProductGroup.ListCount - 1
'determine corresponding listindex of product group
If lstProductSchProductGroup.List(index) = data_productSchedule( _
cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence.ListIndex) Then
lstProductSchProductGroup.ListIndex = index
Exit For
End If
Next index
End If
'set quantity
txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex *   _
_
3 + 1, lstProductSchSequence.ListIndex)
cmdProductSchProductGroupDeleteSelection.Visible = False
Else
Beep
End If
End Sub

Private Sub cboProductSchSelectDate_Change()
Dim index
'update of userform
'reset listbox product sequence
lstProductSchSequence.ListIndex = 0
For index = 0 To lstProductSchSequence.ListCount - 1
lstProductSchSequence.List(index, 1) = ""
Next index
'set listbox product sequence
For index = 0 To lstProductSchSequence.ListCount - 1
If data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, index) = 1 Then
lstProductSchSequence.List(index, 1) = "assigned"
Else
Exit For
End If
Next index
lstProductSchSequence.ListIndex = index
'set product group
lstProductSchProductGroup.ListIndex = -1
'search corresponding product group if value in array  0
If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence. _
ListIndex)  0 Then
For index = 0 To lstProductSchProductGroup.ListCount - 1
'determine corresponding listindex of product group
If lstProductSchProductGroup.List(index) = data_productSchedule( _
cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence.ListIndex) Then
lstProductSchProductGroup.ListIndex = index
Exit For
End If
Next index
End If
'set quantity
txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex * 3 +   _
_
1, lstProductSchSequence.ListIndex)
End Sub

Private Sub cmdProductSchDeleteModification_Click()
Dim index, index2, index3, index4
If cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1)  "" Then
If MsgBox("Do you want to delete the modifications made?", vbQuestion + vbYesNo) = vbNo  _
_
Then Exit Sub
If tab_Product_Schedule_saved = False Then
'replace data in array all 0
For index2 = 0 To UBound(data_productSchedule, 2)
data_productSchedule(cboProductSchSelectDate.ListIndex * 3, index2) = 0
data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, index2) = 0
data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, index2) = 0
Next index2
'replace data in array with data from output table
index = 0
index2 = 0
While Sheet4.Cells(5 + index, "D").Value  ""
'determine corresponding listindex of date  Format(Sheet4.Cells(5 + index, "D"). _
_
Value, "dd/mm/yyyy")
If Format(Sheet4.Cells(5 + index, "D").Value, "dd/mm/yyyy") =  _
cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 0) Then
data_productSchedule(cboProductSchSelectDate.ListIndex * 3, index2) =  _
Sheet4.Cells(5 + index, "F").Value
data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, index2) =   _
_
Sheet4.Cells(5 + index, "G").Value
index2 = index2 + 1
End If
index = index + 1
Wend
Else
'replace data in array with data from output table
index = 0
index2 = cboProductSchSelectDate.ListIndex
For index = 3 To 25
data_productSchedule(index2, index - 3) = Sheet9.Cells(index2 + 2, index).Value
data_productSchedule(index2 + 1, index - 3) = Sheet9.Cells(index2 + 2 + 1,  _
index).Value
data_productSchedule(index2 + 2, index - 3) = 0
Next index
'replace IDs with name of product groups in array
'determine number of product groups
index4 = 0
While Sheet4.Cells(5 + index4, "EL").Value  ""
index4 = index4 + 1
Wend
index = cboProductSchSelectDate.ListIndex
For index2 = 0 To UBound(data_productSchedule, 2)
For index3 = 0 To index4 - 1
If data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EK"). _
Value Then
data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EL"). _
Value
End If
Next index3
Next index2
End If
lstProductSchProductGroup.ListIndex = -1
'search corresponding product group if value in array  0
If data_productSchedule(0, 0)  0 Then
For index = 0 To lstProductSchProductGroup.ListCount - 1
'determine corresponding listindex of product group
If lstProductSchProductGroup.List(index) = Sheet4.Cells(5, "F").Value Then
lstProductSchProductGroup.ListIndex = index
Exit For
End If
Next index
End If
'set textbox quantity
txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex *   _
_
3 + 1, 0)
cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = ""
lstProductSchSequence.ListIndex = 0
For index = 0 To lstProductSchSequence.ListCount - 1
lstProductSchSequence.List(index, 1) = ""
Next index
cmdProductSchProductGroupDeleteSelection.Visible = False
End If
End Sub

Public Sub cmdSaveProductS_Click()
Dim index, index2
Dim suchArray()
Dim ersetzArray()
Dim k As Long
Dim tmp
tmp = MsgBox("Do you want to save the new data configuration for Product Schedule?",  _
vbQuestion + vbYesNo, "Save data of Product Schedule")
If tmp = vbYes Then
'calculate simulation time in minutes
Sheet6.Cells(12, "E").Value = (datediff("d", Sheet13.txtSDI.Value, Sheet13.txtEDI.Value) _
_
+ 1) * 24 * 60
tab_Product_Schedule_saved = True
Sheet9.Range("C2:Y57").ClearContents
'save data from array in output table
For index = 0 To UBound(data_productSchedule, 1) / 3
For index2 = 0 To UBound(data_productSchedule, 2)
Sheet9.Cells(2 + index * 2, 3 + index2).Value = data_productSchedule(index * 3,  _
_
index2)
Sheet9.Cells(2 + index * 2 + 1, 3 + index2).Value = data_productSchedule(index * _
_
3 + 1, index2)
Next index2
Next index
'replace name of product groups in output table with IDs
ReDim suchArray(lstProductSchProductGroup.ListCount - 1)
ReDim ersetzArray(lstProductSchProductGroup.ListCount - 1)
index = 0
While Sheet4.Cells(5 + index, "EL").Value  ""
'ReDim Preserve suchArray(index)
'ReDim Preserve ersetzArray(index)
suchArray(index) = Sheet4.Cells(5 + index, "EL").Value
ersetzArray(index) = Sheet4.Cells(5 + index, "EK").Value
index = index + 1
Wend
For k = LBound(suchArray) To UBound(suchArray)
'Call ActiveSheet.UsedRange.Replace(suchArray(k), ersetzArray(k), , , False)
Call Sheet9.UsedRange.Replace(suchArray(k), ersetzArray(k), xlWhole, , True, False)
Next k
Erase data_productSchedule
Unload Me
End If
End Sub

Private Sub cmdCancelProductS_Click()
Dim tmp
tmp = MsgBox("Do you want to quit the userform Product Schedule?", vbQuestion + vbYesNo)
If tmp = vbYes Then
Erase data_productSchedule
Unload Me
End If
End Sub