Help with function to generate a list

[Jennifer]

I would like to write a some VBA code for use in a Word macro that needs to generate a list of values according to another list.

The source list is of the form value, count, value, count, ... For example: "red", 5, "blue", 3, "green", 2.

The result list will have 10 entries: 5 "red"'s, 3 "blues"'s, and 2 "greens"'s: "red", "red", "red", "red", "red", "blue", "blue", "blue", "green", "green". I don't care about the order.

The calling syntax would be something like this:


result = GenArray("Red", 5, "Blue", 3, "Green", 1, ...)

I came up with a solution that returns a delimited string, which the caller then needs to Split into an Array:



...caller code

Dim ColorSet As String
Dim ColorArray() As String
ColorSet = GenArray("Red", 5, "Blue", 3, "Green", 1)
ColorArray = Split(ColorSet, " ")

... caller code


Here's the Function code:



Function GenArray(ParamArray Param() As Variant)

Dim i1 As Integer 'Loop index
Dim i2 As Integer 'Color array index
For i1 = 0 To UBound(Param) Step 2
'Call MsgBox("Parm " & i & " = " & Param(i), vbOK, "GenArray")
For i2 = 1 To Param(i1 + 1)
GenArray = GenArray & " " & Param(i1)
Next i2
Next i1

End Function


This works. Two questions:

Is there a better way?
Is there a way for the function to so the Split and return the array?


Thanks

[Jennifer]

I found some improvements for the function and added comments.

This code works as far as I have tested it. If anyone can see a better way to do this, please comment.



'-----------------------------------------------------------------------------------
' GenColorsArray Function

' It is named "List" for now. Change to "Array" if I find out how to pass back an array.

' Syntax: list = GenColorsArray(Color1, Count1, Color2, Count2, ...)

' Colori = An RGB color value (from the RGB function)
' Counti = The number of entries (>=0, 0 = zero entries)
' list = A list of space-delimited colors: Color1 Color1 ... Color2 ...

' Example: list = GenColorsArray(RGBCrimson, 5, RGBRed, 2, RGBBlue, 6, RGBBlack, 0)

'Change Log: See Prolog & Change Log, Word Macros.docx.
'-----------------------------------------------------------------------------------
Function GenColorsArray(ParamArray Param() As Variant) As Variant
Const MyName As String = "GenColorsArray"

'Check that there are an even number of parameters
If (UBound(Param) / 2) = (UBound(Param) \ 2) Then
MsgBox "Odd number of parameters", vbOK, MyName
GenColorsArray = Array()
Exit Function
End If

Dim i1 As Integer 'Parameter loop index
Dim i2 As Integer 'Color copies index
Dim GenColorsList As String
GenColorsList = ""
For i1 = 0 To UBound(Param) Step 2
For i2 = 1 To Param(i1 + 1)
GenColorsList = GenColorsList & Param(i1) & " "
Next i2
Next i1

'Strip off the final (trailing) delimiter
GenColorsList = RTrim(GenColorsList) 'Only works for space delimiter
'GenColorsList = Left(GenColorsList, Len(GenColorsList) - 1) 'Works for any delimiter

'Split the list into an array
GenColorsArray = Split(GenColorsList, " ")

End Function

[SamT]

Jennifer,

The code you have looks nice and tight. If it works for you, it's good.


The source list is of the form value, count, value, count, ... For example: "red", 5, "blue", 3, "green", 2.

The result list will have 10 entries: 5 "red"'s, 3 "blues"'s, and 2 "greens"'s: "red", "red", "red", "red", "red", "blue", "blue", "blue", "green", "green".

I understand that you want the final result of the code we're talking about to be an array.

An Array can hold other Arrays, so you could have (Using the quote as an example,) a one dimensional array(2) where
Array(0) = Array("red","red","red","red","red")
Array(1) = Array("blue", "blue", "blue")
Array(2) = Array("green", "green")

Or you could have a two D array(2, 4) where
Array(0, 0-4) = "red"
Array(1, 0-2) = "blue"
Array(1, 3-4) = ""
Array(2, 0-1) = "green"
Array(2, 2-4) = ""
Etc

Finally, you can have a 1D array(count+count+count-1) = "red", "red", "red", "red", "red", "blue", "blue", "blue", "green", "green"
That's the code you have now.

You just have to decide which form is going to be easiest to use.

You are not limited to arrays:

A Collection of UDTs

Type ColorCounts
Color As String
Count As Long
End Type
Dim Colors As ColorCounts
Dim MyColors As Collection
For j = 0 to Ubound(List) Step 2
Color = List(j)
Count = List (j + 1)
MyColors. Add Color
Next J

A dictionary would work
Dim Colors As New Scripting.Dictionary '(IIRC)
For j = 0 to Ubound(List) Step 2
Colors.Add List(j), List(j+1)
Next
Dictionary Keys (and Items) can be returned en masse as arrays. In your example the Keys wold be red, green ,and blu and the Items ,5, 3, and 2, but you can reverse them.