How to copy F1:F5 values to a range of scattered cells.

And, can you copy a range of scattered cells to another unlike range of scattered cells?

Howard


Option Explicit
Option Base 0

Sub Copy_Array()

Dim FromArray(5) As Variant
Dim ToArray(5) As Variant
Dim i As Integer

FromArray = Range("F1:F5") ' fails here- 'can't assign to array
ToArray = Range("A1,B2,C3,D4,E5")

For i = LBound(FromArray) To UBound(FromArray)
ToArray(i) = FromArray(i)
Next i

End Sub

You do not need this line...

Option Base 0

...because arrays are zero-based by default!

One way using arrays:
Sub Copy_Array()
'Do not dimension variants you'll be assigning ranges to!
Dim vaSrc, vaTgt, vTmp, n& '(As Long)

'Size your ranges as contiguous
vaSrc = Range("F1:F5"): vaTgt = Range("A1:E5")

'Replace vaSrc data only in vaTgt
For n = LBound(vaSrc) To UBound(vaSrc)
vaTgt(n, n) = vaSrc(n, 1)
Next 'n

'Assign vaTgt to its range
Range("A1:E5") = vaTgt
End Sub

Another way:
Sub Copy_RngToAreas()
Dim vaSrc, rngTgt As Range, n& '(as long type)

vaSrc = Range("F1:F5")
Set rngTgt = Range("A1,B2,C3,D4,E5")

'Replace vaSrc data only in rngTgt
For n = LBound(vaSrc) To UBound(vaSrc)
rngTgt(n, n) = vaSrc(n, 1)
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

On Monday, March 13, 2017 at 9:24:48 PM UTC-7, GS wrote:
You do not need this line...

Option Base 0

..because arrays are zero-based by default!

One way using arrays:
Sub Copy_Array()
'Do not dimension variants you'll be assigning ranges to!
Dim vaSrc, vaTgt, vTmp, n& '(As Long)

'Size your ranges as contiguous
vaSrc = Range("F1:F5"): vaTgt = Range("A1:E5")

'Replace vaSrc data only in vaTgt
For n = LBound(vaSrc) To UBound(vaSrc)
vaTgt(n, n) = vaSrc(n, 1)
Next 'n

'Assign vaTgt to its range
Range("A1:E5") = vaTgt
End Sub

Another way:
Sub Copy_RngToAreas()
Dim vaSrc, rngTgt As Range, n& '(as long type)

vaSrc = Range("F1:F5")
Set rngTgt = Range("A1,B2,C3,D4,E5")

'Replace vaSrc data only in rngTgt
For n = LBound(vaSrc) To UBound(vaSrc)
rngTgt(n, n) = vaSrc(n, 1)
Next 'n
End Sub

--

Thanks, Garry, those work pretty snappy.

I used the diagonal A1 to E5 to represent what I thought to be 'scattered cells, which are contiguous cells, I think...?

Is there a way to copy F1:F5 cells to cells A1, D5, H9, J6, M11, where these are truly 'scattered'?

And a way to copy say, five truly scattered cells to five other truly scattered cells?

Howard

Is there a way to copy F1:F5 cells to cells A1, D5, H9, J6, M11, where these
are truly 'scattered'?

And a way to copy say, five truly scattered cells to five other truly
scattered cells?

Try...

Sub Copy_ScatteredCells()
Const sSrc$ = "F1,F2,F3,F4,F5": Const sTgt$ = "A1,D5,H9,J6,M11"
Dim n&, vaSrc, vaTgt

vaSrc = Split(sSrc, ","): vaTgt = Split(sTgt, ",")
For n = LBound(vaSrc) To UBound(vaSrc)
Range(vaTgt(n)) = Range(vaSrc(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

Try...

Sub Copy_ScatteredCells()
Const sSrc$ = "F1,F2,F3,F4,F5": Const sTgt$ = "A1,D5,H9,J6,M11"
Dim n&, vaSrc, vaTgt

vaSrc = Split(sSrc, ","): vaTgt = Split(sTgt, ",")
For n = LBound(vaSrc) To UBound(vaSrc)
Range(vaTgt(n)) = Range(vaSrc(n))
Next 'n
End Sub

--
Garry

Excellent, works great!

Thanks Garry.

Try...

Sub Copy_ScatteredCells()
Const sSrc$ = "F1,F2,F3,F4,F5": Const sTgt$ = "A1,D5,H9,J6,M11"
Dim n&, vaSrc, vaTgt

vaSrc = Split(sSrc, ","): vaTgt = Split(sTgt, ",")
For n = LBound(vaSrc) To UBound(vaSrc)
Range(vaTgt(n)) = Range(vaSrc(n))
Next 'n
End Sub

--
Garry

Excellent, works great!

Thanks Garry.

That example works fine with a short list of cell addresses, but longer lists
can be better handled as follows:

Sub Copy_ScatteredCells2()
' This matches src/tgt cell addresses as value pairs
' In cases where copying a ranges of cells to ranges of cells,
' Application.Transpose is used.
Dim v1, v2, n&

'Value-pair the Src|Tgt cell addresses
Const sSrcTgt$ = "F1=A1,F2=D5,F3:F5=H9:J9," _
& "A1:A3=K11:M11,B1:C1=P2:P3"
v1 = Split(sSrcTgt, ",")

On Error GoTo Cleanup
For n = LBound(v1) To UBound(v1)
'Parse the Src=Tgt cell addresses
v2 = Split(v1(n), "=")
Range(v2(1)) = Application.Transpose(Range(v2(0)))
Next 'n

Cleanup:
'Error handler code...

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

FWIW:

Here's another approach I use with a task-specific project that has multiple
workbooks it works with. It can transfer data between various workbooks
according to a table stored in ThisProject.xla:

Sub XferRangeValues()
' Transfers range data between multiple workbooks;
' Range refs are stored in a dynamic named range on "Xfers" sheet;
' Opens/closes workbooks as needed.
'
Dim vXfers, wksSrc As Worksheet, wksTgt As Worksheet
Dim n&, k, v1, v2

vXfers = ThisWorkbook.Sheets("Xfers").Range("XferRefs")
Const sUsrDat$ = ThisWorkbook.Path & "\UserData\"

For n = LBound(vXfers) To UBound(vXfers)
On Error Resume Next
GetSrc:
Set wksSrc = Workbooks(vXfers(n, 1)).Sheets(vXfers(n, 2))
If wksSrc Is Nothing Then '//file not open
Workbooks.Open sUsrDat & vXfers(n, 1): GoTo GetSrc
End If
GetTgt:
Set wksTgt = Workbooks(vXfers(n, 4)).Sheets(vXfers(n, 5))
If wksTgt Is Nothing Then
Workbooks.Open sUsrDat & vXfers(n, 4): GoTo GetTgt
End If
Err.Clear: On Error GoTo Cleanup

v1 = Split(vXfers(n, 3), ","): v2 = Split(vXfers(n, 6), ",')
For k = LBound(v1) To UBound(v1)
wksTgt.Range(v2(k)) = Application.Transpose(wksSrc.Range(v1(k)))
Next 'k
wksSrc.Parent.Close True: wksTgt.Parent.Close True
Next 'n

Cleanup:
Set wksSrc = Nothing: Set wksTgt = Nothing
End Sub 'XferRangeValues

--
Garry

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

I recall being able to keep workbooks open if they were next up so I checked
and found I had revised the 'working' project as follows...


Sub XferRangeValues()
' Transfers range data between multiple workbooks;
' Range refs are stored in a dynamic named range on "Xfers" sheet;
' Opens/closes workbooks as needed.
'
Dim vXfers, wksSrc As Worksheet, wksTgt As Worksheet
Dim n&, k, v1, v2

vXfers = ThisWorkbook.Sheets("Xfers").Range("XferRefs")
Const sUsrDat$ = ThisWorkbook.Path & "\UserData\"

For n = LBound(vXfers) To UBound(vXfers)
On Error Resume Next
GetSrc:
Set wksSrc = Workbooks(vXfers(n, 1)).Sheets(vXfers(n, 2))
If wksSrc Is Nothing Then '//file not open
Workbooks.Open sUsrDat & vXfers(n, 1): GoTo GetSrc
End If
GetTgt:
Set wksTgt = Workbooks(vXfers(n, 4)).Sheets(vXfers(n, 5))
If wksTgt Is Nothing Then
Workbooks.Open sUsrDat & vXfers(n, 4): GoTo GetTgt
End If
Err.Clear: On Error GoTo Cleanup

v1 = Split(vXfers(n, 3), ","): v2 = Split(vXfers(n, 6), ",')
For k = LBound(v1) To UBound(v1)
wksTgt.Range(v2(k)) = Application.Transpose(wksSrc.Range(v1(k)))
Next 'k
If Not vXfers(n + 1, 1) = vXfers(n, 1) Then wksSrc.Parent.Close True
If Not vXfers(n + 1, 4) = vXfers(n, 4) Then wksTgt.Parent.Close True
Next 'n

Cleanup:
Set wksSrc = Nothing: Set wksTgt = Nothing
End Sub 'XferRangeValues

...and updated the component file accordingly. (I store frm/bas/cls files in a
"Src" folder for each project. This is where I pulled code for this thread
from!)

--
Garry

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

FWIW:
Just thought I'd share this...


The usage scenario that spawned this process is as follows:

Client-specific tasking to:
a. distribute updated product templates to field reps;
This uses a single source file, multiple target files;
Each field rep's file has an open password, as it also had a 'Notes'
sheet that usually contained confidential rep-specific info;
Each field rep accessed their update file via remote login to the
server.

b. collect previous period files from field reps;
Each field rep uploaded their current working file weekly;
- (this could be during downloading of new templates)
This uses a single target file, multiple source files.

c. distribute various sheets from various files to various staff in
various departments;
This uses various source/target files.

Notes:
The 'Admin' user has restricted access according to their specific need, and so
this was managed in the app via login credentials.

Both field reps and office staff use the same addin. Access to functionality is
controlled via login credentials.

All source/target file require an open password; -this was also stored in the
appropriate Src/Tgt table listing.

All tasks are menu-driven.

--
Garry

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