Hi Howard,

Am Mon, 17 Mar 2014 05:19:17 -0700 (PDT) schrieb L. Howard:

Range D46:N65 is blank as a matter of normal use. It is filled manually by placing certain words in each column D, F, H, J, L, M. Then a single word from each column produces a short phrase.

then fill range AQ only if there are values in range D:N.
Instead of formula use following macro:

Sub FillAQ()
Dim rngC As Range
Dim i As Long
Dim myStr As String

For Each rngC In Range("AQ2:AQ131")
myStr = ""
For i = 19 To 29 Step 2
If Len(Cells(rngC.Row, i)) 0 Then
myStr = myStr & Cells(rngC.Row, i) & " "
End If
Next
myStr = RTrim(myStr)
rngC = myStr
Next
End Sub

And change the Randomize macro to:

Sub Six_By_Six_Title_Randomizer()
'/ by Claus
Dim a(19) As Variant, b, c, d, e, f
Dim Small As Integer, Big As Integer
Dim i As Long, j As Long, n As Long, k As Long
Dim conT As Long
Dim iI As Long
Dim arrOut As Variant
Dim myCol As Long

Application.ScreenUpdating = False

[AE2:AO2010,A2:A12100].ClearContents

Small = 1
For conT = 1 To 100
For n = 2 To 112 Step 22
For k = 3 To 13 Step 2

Big = Small + 19
j = 0
For i = Small To Big
a(j) = i
j = j + 1
Next
b = a: Randomize
d = UBound(b)
For c = 0 To d
e = Int(d * Rnd) + 1
f = b(c): b(c) = b(e): b(e) = f
Next

Cells(n, k).Resize(rowsize:=20) = WorksheetFunction.Transpose(b)

Small = Small + 20

Next 'k

Next 'n

FillAQ

myCol = 31
For iI = 2 To 112 Step 22
arrOut = Range("AQ" & iI).Resize(rowsize:=20)
Cells(Rows.Count, myCol).End(xlUp).Offset(1, 0) _
.Resize(rowsize:=20) = arrOut
myCol = myCol + 2
Next

Small = 1
Next 'conT

Application.ScreenUpdating = True

End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2