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

I need another nudge.
Want to transfer data workbook Y.
A list of target worksheets in book Y is in column AU of the source workbook/worksheet.
The target column for each target sheet is next to it in column AV.

The code errors out on this line where I have put "c" and c in place of "what goes here??"

Set wksTarget = wkbTarget.Sheets("What goes here??")
Set wksTarget = wkbTarget.Sheets("c")
Set wksTarget = wkbTarget.Sheets(c)

None work.

The Msgboxes both return a correct sheet name and a column number.
Which is Allee & 1 as they are the first entries of the list.

Thanks,
Howard


Sub Transfer_Titles()
Dim myRng As Range
Dim rngC As Range
Dim i As Long
Dim myArr() As Variant

Dim wksSource As Worksheet, wksTarget As Worksheet
Dim wkbSource As Workbook, wkbTarget As Workbook
Dim rngSource As Range, rngTarget As Range

Dim c As Range
Dim trgWs As Range
Dim trgCol As Long

Set myRng = Range("A2:A12100")

For Each rngC In myRng
ReDim Preserve myArr(myRng.Cells.Count - 1)
myArr(i) = rngC
i = i + 1
Next

'/ List of target sheet names in column AU2:AU21
'/ Destination column for each target sheet is in AV next to sheet name

Set wkbSource = Workbooks("Title Builder Randomizer rev 2.0 xfer titles.xlsm")
Set wkbTarget = Workbooks("Y.xlsm")

For Each c In Range("AU2:AU21")
MsgBox c
trgCol = c.Offset(0, 1)
MsgBox trgCol

Set wksTarget = wkbTarget.Sheets("What goes here??")

With wksSource
wksTarget.Cells(2, trgCol).Resize(rowsize:=myRng.Cells.Count) _
= WorksheetFunction.Transpose(myArr)
End With
Next 'c
End Sub

Also, I added this in case the workbook Y was not open.

If Not IsFileOpen("C:\Users\Howard Kittle\Documents\Y.xlsm") Then
Workbooks.Open ("C:\Users\Howard Kittle\Documents\Y.xlsm")
End If

It does indeed open the workbook if not open and the code runs on down until it errors out as I posted above.

However, the Msgboxes both return blank until the code is run again, then correct data is indicated. (of course it still errors out on that same line)

I don't understand why it prevents the variables from returning in the msgboxes on the opening run.

Howard

Hi Howard,

Am Tue, 18 Mar 2014 14:41:45 -0700 (PDT) schrieb L. Howard:

I need another nudge.
Want to transfer data workbook Y.
A list of target worksheets in book Y is in column AU of the source workbook/worksheet.
The target column for each target sheet is next to it in column AV.

Then try:

Sub Transfer_Titles()

Dim Dest As Range
Dim i As Long
Dim myArr() As Variant
Dim arrDest As Variant
Dim LRow As Long
Dim wkbSource As Workbook, wkbTarget As Workbook

LRow = Cells(Rows.Count, 1).End(xlUp).Row

myArr = Range("A2:A" & LRow)

'/ List of target sheet names in column AU2:AU21
'/ Destination column for each target sheet is in AV next to sheet name

Set wkbSource = ThisWorkbook
Set wkbTarget = Workbooks("Y.xlsm")

arrDest = Range("AU2:AV21")
For i = LBound(arrDest) To UBound(arrDest)
Set Dest = wkbTarget.Sheets(arrDest(i, 1)).Cells(2, arrDest(i, 2))
Dest.Resize(rowsize:=UBound(myArr)) = myArr
Dest.EntireColumn.AutoFit
Next 'i
End Sub


Regards
Claus B.
--
Vista Ultimate SP2 / Windows7 SP1
Office 2007 Ultimate SP3 / 2010 Prodessional