Function: Randomly Selected, Alphabetized, Concatenated

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
2. Loaded  the array
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