Tuesday, October 21, 2014

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