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

### Like this:

Like Loading...