Userform array/subsript range error

[Bijl167]

Hi !

I've created a userform with different listboxes on it (total items in
the boxes >40). I managed to read out the multiple selections in the
boxes but for some reason it only works up to 5 or 6 items. I keep on
getting the following error message: "Run time error 9, Subscript out
of range" I've tried the suggestions in VBA Help but i do not get it
working. can anyone help?

this is the code I use:
---------------------------------------------------------------------------------
Private Sub CmdOK_Click()

With FrmZoneSheet.EU1list

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim myarr1() As String
ReDim myarr1(EU1list.ListCount - 1)
tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt
For i = 0 To EU1list.ListCount - 1
If EU1list.Selected(i) = True Then
myarr1(j) = EU1list.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr1(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr1(j)
End With

With FrmZoneSheet.EU2list

Dim myarr2() As String
ReDim myarr2(EU2list.ListCount - 1)
tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To EU2list.ListCount - 1
If EU2list.Selected(i) = True Then
myarr2(j) = EU2list.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr2(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr2(j)
End With

With FrmZoneSheet.NAlist

Dim myarr3() As String
ReDim myarr3(NAlist.ListCount - 1)

tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To NAlist.ListCount - 1
If NAlist.Selected(i) = True Then
myarr3(j) = NAlist.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr3(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr3(j)
End With

With FrmZoneSheet.LAlist

Dim myarr4() As String
ReDim myarr4(LAlist.ListCount - 1)

tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To LAlist.ListCount - 1
If LAlist.Selected(i) = True Then
myarr4(j) = LAlist.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr4(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr4(j)
End With

With FrmZoneSheet.As1list

Dim myarr5() As String
ReDim myarr5(As1list.ListCount - 1)

tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To As1list.ListCount - 1
If As1list.Selected(i) = True Then
myarr5(j) = As1list.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr5(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr5(j)
End With

With FrmZoneSheet.As2list

Dim myarr6() As String
ReDim myarr6(As2list.ListCount - 1)

tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To As2list.ListCount - 1
If As2list.Selected(i) = True Then
myarr6(j) = As2list.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr6(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr6(j)
End With

With FrmZoneSheet.Palist

Dim myarr7() As String
ReDim myarr7(Palist.ListCount - 1)
tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To Palist.ListCount - 1
If Palist.Selected(i) = True Then
myarr7(j) = Palist.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr7(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr7(j)
End With

With FrmZoneSheet.MElist

Dim myarr8() As String
ReDim myarr8(MElist.ListCount - 1)

tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
k = lrt + 1
For i = 0 To MElist.ListCount - 1
If MElist.Selected(i) = True Then
myarr8(j) = MElist.List(i)
UnprotectSheet
ActiveSheet.Cells((k), fct) = myarr8(j)
j = j + 1
k = k + 1
End If
Next i
ReDim Preserve myarr8(j)
End With

If ChkROW.Value = True Then
tablename = "ZONE-TABLE"
DimensionsofTable tablename, frt, fct, lrt, lct
Cells(lrt + 1, fct).Value = "Rest of World"
End If


Unload Me
End Sub

 

[Bijl167]

Ok sorry to bother you all, I've resolved the problem by making the
array maximum elements equal to the total items of the listboxes
together

cheers,
mb