JustCode : Randomize Cats V2

This function will randomize categories and make sure that some do not sit next to each other.

Sub q13aran(q,o)
    Dim cat, cat1, cat2, cat3, cats
    Dim idx, idx1, idx2, idx3
    Dim strFilt

    ' Randomize
    q.Categories.Order = o
    idx = 0
    idx1 = 0
    idx2 = 0
    idx3 = 0

    ' Find 3 categories interested in
    For Each cat in q.Categories
        idx = idx + 1
        If ( cat = {_18} Or cat = {_19} Or cat = {_20} ) Then
            If ( idx1 = 0 ) then
                idx1 = idx
                cat1 = cat.name
            ElseIf ( idx2 = 0 ) Then
                idx2 = idx
                cat2 = cat.name
            ElseIf ( idx3 = 0 ) Then
                idx3 = idx
                cat3 = cat.name
            End If
        End If
    Next

    ' If not next to each other, then keep what we have
    If ( (idx1 + 1) <> idx2 And (idx2 + 1) <> idx3 ) Then Exit Sub


    If ( (idx1 + 1) = idx2 And (idx2 + 1) = idx3 ) Then  ' If all 3 in a row
        If ( idx1 = 1 ) Then           ' First 3
            idx2 = idx2 + 1
            idx3 = idx3 + 2
        ElseIf ( idx3 = idx ) Then     ' Last 3
            idx1 = idx1 - 2
            idx2 = idx2 - 1
        Else                           ' in middle
            idx1 = idx1 - 1
            idx3 = idx3 + 1
        End If
    ElseIf ( idx1 = 1 And idx2 = 2 And idx3 = 4 ) Then  ' 1,2,4
        idx2 = 3
        idx3 = 5
    ElseIf ( idx1 = 1 And idx2 = 3 And idx3 = 4 ) Then  ' 1,3,4
        idx2 = 3
        idx3 = 5
    ElseIf ( (idx1 = (idx - 3)) And idx2 = (idx - 1) And idx3 = idx ) Then  ' last-3,last-1,last
        idx1 = idx1 - 1
        idx2 = idx2 - 1
    ElseIf ( (idx1 = (idx - 3)) And idx2 = (idx - 2) And idx3 = idx ) Then  ' last-3,last-2,last
        idx1 = idx3 - 4
        idx2 = idx3 - 2
    Else

        If ( (idx1 + 1) = idx2 ) Then
            If ( idx1 = 1 ) Then          ' idx1 is first category
                idx2 = 3
            Else
                idx1 = idx1 - 1
            End If
        End If

        If ( (idx2 + 1) = idx3 ) Then
            If ( idx3 = idx ) Then         ' idx3 is last category
                idx2 = idx2 - 1
            Else
                idx3 = idx3 + 1
            End If
        End If

    End If

    ' Convert list into a string of categories
    strFilt = ""
    idx = 1
    For Each cat in q.Categories
        If ( idx = idx1 ) Then
            strFilt = strFilt + cat1 + ","
            idx = idx + 1
        ElseIf ( idx = idx2 ) Then
            strFilt = strFilt + cat2 + ","
            idx = idx + 1
        ElseIf ( idx = idx3 ) Then
            strFilt = strFilt + cat3 + ","
            idx = idx + 1
        End If
        If ( cat <> {_18} And cat <> {_19} And cat <> {_20} ) Then
            strFilt = strFilt + cat.name + ","
            idx = idx + 1
        End If
    Next

    ' Put into custom order in .Categories
    strFilt = Left(strFilt,Len(strFilt) - 1)
    q.Categories.Filter = {}
    q.Categories.Order = OrderConstants.oCustom
    cats = split(strFilt,",")
    For idx = lbound(cats) to ubound(cats)
        q.Categories.Filter = q.Categories.Filter + CCAtegorical("{" + cats[idx] + "}")
    Next

    ' Catch all to ensure these are all captured - should never happen
    If ( FindItem(q.CAtegories,{_18}) is null ) Then q.Categories = q.Categories + {_18}
    If ( FindItem(q.CAtegories,{_19}) is null ) Then q.Categories = q.Categories + {_19}
    If ( FindItem(q.CAtegories,{_20}) is null ) Then q.Categories = q.Categories + {_20}

End Sub