On Monday, March 17, 2014 2:14:59 AM UTC-7, Claus Busch wrote:
Hi Howard,



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



If Len(Trim$(Tlt)) 0 Then ActiveCell.Value = Tlt



why has range D46:N65 no data?

Or how should it be filled?





Regards

Claus B.

On Monday, March 17, 2014 2:14:59 AM UTC-7, Claus Busch wrote:
Hi Howard,



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



If Len(Trim$(Tlt)) 0 Then ActiveCell.Value = Tlt



why has range D46:N65 no data?

Or how should it be filled?

Hi Claus,

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.

I don't know exactly why it is blank, except the user may only want 5 individual short phrases in each result returned to column A. May also only want 4 short phrases in the column A return, so 2 of those colored ranges could be blank.

You most likely picked up that each of those section (above and below the D46:N65 blank range) provide the words for a randomly selected phrase. So if all sections are filled with words then there would be 6 short phrases in each cell in column A.

That is why I thought the solution should be manipulating the data in column A rather rewrite all the main code. The code works very well as written.

Howard

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

Hi Howard,

Am Mon, 17 Mar 2014 13:44:55 +0100 schrieb Claus Busch:

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.

have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for workbook "Title Builder Randomizer rev 2.0.xlsm"


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

have a look:

https://onedrive.live.com/?cid=9378A...121822A3%21326

for workbook "Title Builder Randomizer rev 2.0.xlsm"





Regards

Claus B.

--
have a look:

https://onedrive.live.com/?cid=9378A...121822A3%21326

for workbook "Title Builder Randomizer rev 2.0.xlsm"





Regards

Claus B.

--

Wonderful!!!

I will be adamant to the user who has made this work so well.

I should have known that it is best fix the problem at the source instead of patching up poor results.

I'll study the old code and new to see if I can gather some insight on how you did that. Most of it remains over my head, but I pick up a little bit from time to time.

Thanks Claus.

Regards,
Howard

Hi Howard,

Am Mon, 17 Mar 2014 10:07:46 -0700 (PDT) schrieb L. Howard:

I'll study the old code and new to see if I can gather some insight on how you did that. Most of it remains over my head, but I pick up a little bit from time to time.

this code only reads cells with values into the array instead of 6
items.
And so the range is resized with Ubound(arrOut) +1 you get no empty
cells.


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

this code only reads cells with values into the array instead of 6

items.

And so the range is resized with Ubound(arrOut) +1 you get no empty

cells.





Regards

Claus B.

--

So I'm thinking that is done here where the space " " is replaced with nothing "" and if still greater than 0 it means there is text so it reads it into the array.

If Len(Replace(Tlt.Offset(0, i), " ", "")) 0 Then
ReDim Preserve arrOut(j)
arrOut(j) = Tlt.Offset(0, i)
j = j + 1
End If

Hi Howard,

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

So I'm thinking that is done here where the space " " is replaced with nothing "" and if still greater than 0 it means there is text so it reads it into the array.

If Len(Replace(Tlt.Offset(0, i), " ", "")) 0 Then
ReDim Preserve arrOut(j)
arrOut(j) = Tlt.Offset(0, i)
j = j + 1
End If

yes, that is the only change I made


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