Scattered array cells copy to scattered array cells another workbook

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

The code works fine copying to the resized Range M2 in the target workbook.

wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr


I want his array from wksSource

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

To workbook "Copy of long.xlsm"

wksTarget.Columns.[8, 6, 4, 5, 3, 7, 2 ,10, 3].End(xlUp)(2) = myArr
(translated to workable code of course)

Thanks.
Howard


Sub AbookToLong()
Dim myRng As Range, MyRng1 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

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

Set wkbSource = Workbooks("Array cells to another workbook.xlsm")
Set wkbTarget = Workbooks("Copy of long.xlsm")
Set wksSource = wkbSource.Sheets("Sheet1")
Set wksTarget = wkbTarget.Sheets("Sheet1")

Application.ScreenUpdating = False

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

With wksSource
'wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr
wksTarget.Columns.[8, 6, 4, 5, 3, 7, 2 ,10, 3] = myArr
End With

'wksSource.Range("C7:C18").Copy
' wksTarget.Range("X2").PasteSpecial Transpose:=True
'wksSource.Range("C33:C50").Copy
' wksTarget.Range("AJ2").PasteSpecial Transpose:=True

Application.ScreenUpdating = False
End Sub
 
I tried this for the destination and it enters "A2" in all cells. The destination cells are on a compact slant for easy checking. I can't figure out what it is telling me by doing that...?

With wksSource
'wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr
wksTarget.Range("A2,B3,C4,D5,E6,F7,G8,H9,I10") = myArr
End With

I should mention perhaps that the values in every cell is also the cell address.

On the sheet cell A2 has "A2" in it and the same for all the rest, the cell holds it own address. I thought that made sense until it started to confuse me.

Howard
 
The code works fine copying to the resized Range M2 in the target
workbook.

wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr


I want his array from wksSource

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

To workbook "Copy of long.xlsm"

wksTarget.Columns.[8, 6, 4, 5, 3, 7, 2 ,10, 3].End(xlUp)(2) = myArr
(translated to workable code of course)

Thanks.
Howard


Sub AbookToLong()
Dim myRng As Range, MyRng1 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

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")
Click to expand...

This refs the current active sheet!
Set wkbSource = Workbooks("Array cells to another workbook.xlsm")
Set wkbTarget = Workbooks("Copy of long.xlsm")
Set wksSource = wkbSource.Sheets("Sheet1")
Set wksTarget = wkbTarget.Sheets("Sheet1")

Application.ScreenUpdating = False

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

With wksSource
'wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) =
myArr wksTarget.Columns.[8, 6, 4, 5, 3, 7, 2 ,10, 3] = myArr
End With
Click to expand...

I don't understand using a With clause here since nothing is reffing
anything on wksSource!
'wksSource.Range("C7:C18").Copy
' wksTarget.Range("X2").PasteSpecial Transpose:=True
'wksSource.Range("C33:C50").Copy
' wksTarget.Range("AJ2").PasteSpecial Transpose:=True

Application.ScreenUpdating = False
End Sub
Click to expand...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Hi Garry,

Here is the example/s I'm working off of, includes three from you which I have not been able to figure how to ...Dump the array into the target sheet.

In AbookToLong code the only thing I am trying to do is use the commented out line instead of the resize M2 line to dump to the target workbook.

I failed to note it but I am sure Claus wrote this one.

Seems to me that dumping an array to cells that are not all together in a row or a column is quite difficult.

You were helping me once on this and I was able to persuade the OP to revamp the worksheet to accept the tradional array dump.

I'm back with a need to do dump to 'scattered columns/cells' if practical.

If not, I will pass it on as impractical or not code worthy or whatever.

Howard

Sub AbookToLong()
Dim myRng As Range, MyRng1 As Range
Dim rngS As Range, rngD 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

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

Set wkbSource = Workbooks("Array cells to another workbook.xlsm")
Set wkbTarget = Workbooks("Copy of long.xlsm")
Set wksSource = wkbSource.Sheets("Sheet1")
Set wksTarget = wkbTarget.Sheets("Sheet1")

Application.ScreenUpdating = False

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

With wksSource
wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr

'This is the non working attempt by me
'wksTarget.Range("A2,B3,C4,D5,E6,F7,G8,H9,I10") = myArr

End With

'//*****Ignore these commeted out lines******//
'wksSource.Range("C7:C18").Copy
' wksTarget.Range("X2").PasteSpecial Transpose:=True
'wksSource.Range("C33:C50").Copy
' wksTarget.Range("AJ2").PasteSpecial Transpose:=True

Application.ScreenUpdating = False
End Sub


'Another way...
'/ Garry

Sub MoveScatteredValues()
Dim v, vaMyVals(), iIncr%
Const sRngRefs$ = "B2,G2,B11,K16,F17"
For Each v In Split(sRngRefs, ",")
ReDim Preserve vaMyVals(iIncr)
vaMyVals(iIncr) = Range(v).Value
iIncr = iIncr + 1
Next 'v
'Dump the array into the target sheet
'...
End Sub

'-OR-

'..if the range addresses were stored in a named range...

Sub MoveScatteredValues2()
Dim v, vaMyVals(), iIncr%
For Each v In Split(Range("RngRefs").Value, ",")
ReDim Preserve vaMyVals(iIncr)
vaMyVals(iIncr) = Range(v).Value
iIncr = iIncr + 1
Next 'v
'Dump the array into the target sheet
'...
End Sub

'-OR-

'..if the range addresses are not just single cells, then a modified
'version of Claus' idea...

'Range("RngRefs").Value: "B2,G2,B11:F11,K16,F17"

Sub MoveScatteredValues3()
Dim c As Range, sRefs$, vaMyVals(), iIncr%
sRefs = Range("RngRefs").Value
For Each c In Range(sRefs)
ReDim Preserve vaMyVals(iIncr)
vaMyVals(iIncr) = Range(c).Value
iIncr = iIncr + 1
Next 'c
'Dump the array into the target sheet
'...
End Sub
 
Fixing yours so it works as expected...

Sub AbookToLong()
Dim myRng As Range, rngS As Range
Dim i As Long, myArr() As Variant

Dim wksSource As Worksheet, wksTarget As Worksheet
Dim wkbSource As Workbook, wkbTarget As Workbook

Set wkbSource = Workbooks("Array cells to another workbook.xlsm")
Set wkbTarget = Workbooks("Copy of long.xlsm")
Set wksSource = wkbSource.Sheets("Sheet1")
Set wksTarget = wkbTarget.Sheets("Sheet1")
Set myRng = wksSource.Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

Application.ScreenUpdating = False

ReDim myArr(myRng.Cells.Count - 1)
For Each rngS In myRng
myArr(i) = rngS.Value: i = i + 1
Next

Set myRng = wksTarget.Range("A2,B3,C4,D5,E6,F7,G8,H9,I10")
i = 0
For Each rngS In myRng
rngS.Value = myArr(i): i = i + 1
Next

Application.ScreenUpdating = False
End Sub

...and how I'd do it...

Sub AbookToLong2()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim wkbSource As Workbook, wkbTarget As Workbook
Dim n&, v1, v2

Set wkbSource = Workbooks("Array cells to another workbook.xlsm")
Set wkbTarget = Workbooks("Copy of long.xlsm")
Set wksSource = wkbSource.Sheets("Sheet1")
Set wksTarget = wkbTarget.Sheets("Sheet1")
v1 = Split("A2,A4,R20,C10,N2,O4,F8,H12,G14", ",")
v2 = Split("A2,B3,C4,D5,E6,F7,G8,H9,I10", ",")

For n = LBound(v1) To UBound(v1)
wksTarget.Range(v2(n)) = wksSource.Range(v1(n))
Next 'n
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Hi Howard,

Am Sat, 12 Jul 2014 16:25:04 -0700 (PDT) schrieb L. Howard:
wksTarget.Range("M2").Resize(columnsize:=myRng.Cells.Count) = myArr

I want his array from wksSource

Set myRng = Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

To workbook "Copy of long.xlsm"

wksTarget.Columns.[8, 6, 4, 5, 3, 7, 2 ,10, 3].End(xlUp)(2) = myArr
(translated to workable code of course)
Click to expand...

if I understand you correctly try (the code is in wksSource):

Sub ABookToLong()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim arrCells() As Variant, arrCols As Variant
Dim myRng As Range, rngC As Range
Dim strCols As String
Dim i As Long

Set wksSource = ThisWorkbook.Sheets("Sheet1")
Set wksTarget = Workbooks("Copy of long.xlsm").Sheets("Sheet1")
Set myRng = wksSource.Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

strCols = "8,6,4,5,3,7,2,10,3"
arrCols = Split(strCols, ",")

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

For i = LBound(arrCols) To UBound(arrCols)
wksTarget.Cells(Rows.Count, CInt(arrCols(i))) _
.End(xlUp)(2) = arrCells(i)
Next

End Sub



Regards
Claus B.
 
Hi Garry,

Both work very well.

On mine I was able to add the following to produce a list.

For Each rngS In myRng

rngS.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row) _
.End(xlUp)(2).Value = myArr(i): i = i + 1
Next


Your code is really compact, and clean, if that's the word.

I tried to do the same on yours, but can't find the combination to make it work.

Tried slipping .End(xlUp)(2) in a couple of places but no luck.

Would be nice to have both a specific destination and a listing option also.

Nice nuggets of code, as always. Thanks much.

Howard
 
Hi Claus,

Many thanks, works very well. Just plug-and-play.

Appreciate the help.

Regards,
Howard
 
Hi Garry,
Both work very well.

On mine I was able to add the following to produce a list.

For Each rngS In myRng

rngS.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row) _
.End(xlUp)(2).Value = myArr(i): i = i + 1
Next


Your code is really compact, and clean, if that's the word.

I tried to do the same on yours, but can't find the combination to
make it work.

Tried slipping .End(xlUp)(2) in a couple of places but no luck.

Would be nice to have both a specific destination and a listing
option also.

Nice nuggets of code, as always. Thanks much.

Howard
Click to expand...

Just put the data in an array and 'dump' the array where you want the
list to go. If you use a 1D array and want a col list then transpose
it!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Just put the data in an array and 'dump' the array where you want the

list to go. If you use a 1D array and want a col list then transpose

it!



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion
Click to expand...

I'll give it a go.

Thanks again.

Howard
 
Hi Howard,

Am Sun, 13 Jul 2014 17:36:31 -0700 (PDT) schrieb L. Howard:
Many thanks, works very well. Just plug-and-play.
Click to expand...

glad to help. Thank you for the feedback.

If you like to write the target columns with letters try:

Sub ABookToLong2()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim arrCells() As Variant, arrCols As Variant
Dim myRng As Range, rngC As Range
Dim strCols As String
Dim i As Long

Set wksSource = ThisWorkbook.Sheets("Sheet1")
Set wksTarget = Workbooks("Copy of long.xlsm").Sheets("Sheet1")
Set myRng = wksSource.Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

strCols = "H,F,D,E,C,G,B,J,C"
arrCols = Split(strCols, ",")

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

For i = LBound(arrCols) To UBound(arrCols)
wksTarget.Cells(Rows.Count, Asc(UCase(arrCols(i))) - 64) _
.End(xlUp)(2) = arrCells(i)
Next

End Sub


Regards
Claus B.
 
Hi Howard,



Am Sun, 13 Jul 2014 17:36:31 -0700 (PDT) schrieb L. Howard:






glad to help. Thank you for the feedback.



If you like to write the target columns with letters try:
Click to expand...

That's quite handy, saves having to count the columns when one gets over to the double (and triple) column headings.

Appreciate that.

Howard
 
Hi Howard,

Am Mon, 14 Jul 2014 01:55:57 -0700 (PDT) schrieb L. Howard:
That's quite handy, saves having to count the columns when one gets over to the double (and triple) column headings.
Click to expand...

that is only working for 1 digit column headers.
If you have 2 digits headers you have to change the code:

Sub ABookToLong2()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim arrCells() As Variant, arrCols As Variant
Dim myRng As Range, rngC As Range
Dim strCols As String
Dim i As Long, ColNr As Long

Set wksSource = ThisWorkbook.Sheets("Sheet1")
Set wksTarget = Workbooks("Copy of long.xlsm").Sheets("Sheet1")
Set myRng = wksSource.Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

strCols = "H,F,D,E,C,G,B,J,CA"
arrCols = Split(strCols, ",")

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

For i = LBound(arrCols) To UBound(arrCols)
If Len(arrCols(i)) = 1 Then
ColNr = Asc(UCase(arrCols(i))) - 64
ElseIf Len(arrCols(i)) = 2 Then
ColNr = (Asc(Left(arrCols(i), 1)) - 64) * _
26 + Asc(Right(arrCols(i), 1)) - 64
End If
wksTarget.Cells(Rows.Count, ColNr).End(xlUp)(2) = arrCells(i)
Next

End Sub


Regards
Claus B.
 
Hi Howard,



Am Mon, 14 Jul 2014 01:55:57 -0700 (PDT) schrieb L. Howard:






that is only working for 1 digit column headers.

If you have 2 digits headers you have to change the code:
Click to expand...

Aha! Bad assumption on my part, I did not test.

Thanks for code code AND the heads up.

Howard
 
Back
Top