## Preface

In Function: Random Concatenation I provided a user-defined function (UDF) for worksheet use that would take a range of values (text or numeric), randomize them, and, finally, concatenate as few as 1 to all of them.  To do this the function did the following
1. Used an array of two fields
• Str held the value from the cell
• Val held a random number
• The Lbound was set to 1; Ubound to the number of cells in the range
3. Sorted by Val, the random number.
4. Concatenated the number of values (passed through a parameter), inserting a separator/delimiter (also passed through a parameter).

## Opportunity

That got me to thinking about putting them in order, after doing a random selection. I modified the function to do as above, with these exceptions:

• Added a sort routine on Str, after limiting the the number of fields to be included.
• Added Boolean parameters to turn randomizing and sorting by string on and off.
• Added Boolean parameter and code to allow for reverse sorting the results.
• Put the sort routines into separate functions

## The Code

Option Explicit

Type StrWVal
str As String
val As Double
End Type
-------------------------------------------------------------------
Function RSASConcat(rng As Range, _
Optional sep As String, _
Optional NumToUse As Double, _
Optional Randomize As Boolean, _
Optional SortAlpha As Boolean, Optional Reverse As Boolean)
' RSAS is for Random Selection and Sorted
Const ArrLBound = 1
Dim ArrUBound As Double
Dim MaxToUse As Double
Dim arr() As StrWVal
Dim sorttemp As StrWVal
Dim outtemp As String
Dim i As Double
Dim j As Double
Dim cel As Range
ArrUBound = rng.Cells.Count
ReDim arr(ArrLBound To ArrUBound)
If NumToUse = 0 Then
MaxToUse = ArrUBound
Else
MaxToUse = NumToUse
End If
i = 0
For Each cel In rng
i = i + 1
arr(i).str = cel.Value
arr(i).val = Rnd
Next cel
If Randomize Then
arr = ArrByVal(arr)
ReDim Preserve arr(ArrLBound To MaxToUse)
End If
If SortAlpha Then
arr = ArrByStr(arr)
End If
For i = IIf(Reverse, MaxToUse, ArrLBound) To IIf(Reverse, ArrLBound, MaxToUse) Step IIf(Reverse, -1, 1)
outtemp = outtemp & IIf(Len(outtemp) > 0, sep, "") & arr(i).str
Next i
RSASConcat = outtemp
End Function
--------------------------------------------------------------------
Function ArrByVal(Varr() As StrWVal) As StrWVal()
Dim i As Double
Dim j As Double
Dim ArrLBound As Double
Dim ArrUBound As Double
Dim Tarr() As StrWVal
Dim sorttemp As StrWVal
Tarr = Varr
ArrLBound = LBound(Tarr)
ArrUBound = UBound(Tarr)
For i = ArrLBound To ArrUBound - 1
For j = i + 1 To ArrUBound
If Varr(i).val > Varr(j).val Then
sorttemp = Varr(i)
Varr(i) = Varr(j)
Varr(j) = sorttemp
End If
Next j
Next i
ArrByVal = Varr
End Function
--------------------------------------------------------------------
Function ArrByStr(arr() As StrWVal) As StrWVal()
Dim i As Double
Dim j As Double
Dim ArrLBound As Double
Dim ArrUBound As Double
ArrLBound = LBound(arr)
ArrUBound = UBound(arr)
Dim sorttemp As StrWVal
For i = ArrLBound To ArrUBound - 1
For j = i + 1 To ArrUBound
If arr(i).str > arr(j).str Then
sorttemp = arr(i)
arr(i) = arr(j)
arr(j) = sorttemp
End If
Next j
Next i
ArrByStr = arr
End Function