-
You should separate your logic. Note the function to return individual elements of your Products array. If your UDT is only needed within your userform, then just keep it there as private. Note the Option Base 1. You appear to be set on using base 1 arrays.
[vba]
Option Explicit
Option Base 1
Private Type DataX
CodeX As String
PriceX As Currency
ColorX() As Variant
SizeX() As Variant
End Type
Private Sub Input_Click()
Call ArrayFill
End Sub
Private Sub ArrayFill()
Dim r As Range, Products() As DataX
'initial dim
ReDim Products(1) As DataX
'set to the range of your first product code
Set r = [a1]
Do Until r = ""
Products(UBound(Products)) = ReturnDataX(r)
ReDim Preserve Products(UBound(Products) + 1) As DataX
Set r = r.Offset(, 2)
Loop
ReDim Preserve Products(UBound(Products) - 1) As DataX
Call TestUDTArray(Products)
End Sub
Private Function ReturnDataX(Code As Range) As DataX
Dim rdx As DataX
'you should validate your data here
rdx.CodeX = Code.Text
rdx.PriceX = Code.Offset(, 1).Value
rdx.ColorX = Application.Transpose(Range(Code.Offset(1), Code.Offset(1).End(xlDown)))
rdx.SizeX = Application.Transpose(Range(Code.Offset(1, 1), Code.Offset(1, 1).End(xlDown)))
ReturnDataX = rdx
End Function
'temp procedure to test
Private Sub TestUDTArray(Products() As DataX)
Dim x, y, s, ss
For x = LBound(Products) To UBound(Products)
Debug.Print "----------------------------------------------------"
Debug.Print Products(x).CodeX, Products(x).PriceX
On Error Resume Next
y = 1
Do
s = "": ss = ""
s = CStr(Products(x).ColorX(y))
ss = CStr(Products(x).SizeX(y))
Debug.Print s, ss
y = y + 1
Loop Until (s & ss) = ""
Next
End Sub
[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules