Write to a non contiguous range with VBA

[Markus71]

Dear Users,

I am almost new to VB and I have been out there every night, since days, exploring the web to find a solution to write a range of horzizontal data to a multiple range of non contiguous cells.
After a while I had figured out, how to fill an array with the sourcerange, but pasting to the destinationrange which consists of contigous cells resulted always in the situation, that only the first entry of the array showed up in the destination range. Now, I have found a thread here, which helped me to construct a solution. The thread was >2000days old and the board recommended to start a new threat. Here I am.
Having said that, the solution I have now, works somehow, but it is really slow, because of the 2 loops I am using.

Basically I have a row of horizontal data with 344 cells. Due to the limitations in Range length I have splitted the range in 4x86 cells.
I take the 86 values in an array and then loop through the destination range.
I would appreciate if some pro can take a glance at it and provide me some support to make it faster.

Sub Test_Range3()
    Dim Sourcerng, Destinationrng As Range
    Dim rCell, acell As Range
    Dim i, n As Long

    Application.ScreenUpdating = False
    Set Sourcerng = Sheets("Database").Range("A1:CH1")
     n = Sourcerng.Cells.Count
        ReDim MyAr(1 To n)
        n = 1
        For Each acell In Sourcerng
            MyAr(n) = acell.Value
            n = n + 1
        Next acell
    
    i = 1
    Set Destinationrng = Sheets("Database").Range("L12:L14,L16:L20,L22:L26,L28:L30,L34:L35,M13,M16:M20,M29:M30,N13:N14,N16:N19,N22:N26,O13:O14,O16:O19,Q12:Q14,Q16:Q20,Q22:Q26,Q28:Q30,Q34:Q35,R13,R16:R20,R29:R30,S13:S14,S16:S19,S22:S26,T13:T14,T16:T19")
    For Each rCell In Destinationrng
        rCell.Value = MyAr(i)
       i = i + 1
    Next rCell
Application.ScreenUpdating = True
End Sub

 

[Markus71]

Let's try to clarify what the second code is supposed to do.
My understanding was that it should take whatever data is in row 1 of 'Database' and put those values into that non-contiguous range as follows
A1 goes to L12
A2 -> L13
A3 -> L14
A4 -> L16
.
.
.
Q1 -> L34
R1 -> L35
S1 -> M13
T1 -> M16
etc

If that is not correct, please clarify.

Sorry, again overlapping Peter ...

 

[Akuini]

Akuinis approach works and I'll give it a try, because I assume all my confusion is somehow related to the union function and the order of the elements within.
If I can avoid it, it will be somehow easier for me to understand and I do not have to take care of the areas.

It resolves the problem with 255 char limit & keep the range order intact.
You can uncomment this line:
Debug.Print r.Address
to see the order of the range address in the immediate window.

 

[Markus71]

Let's try to clarify what the second code is supposed to do.
My understanding was that it should take whatever data is in row 1 of 'Database' and put those values into that non-contiguous range as follows
A1 goes to L12
A2 -> L13
A3 -> L14
A4 -> L16
.
.
.
Q1 -> L34
R1 -> L35
S1 -> M13
T1 -> M16
etc

If that is not correct, please clarify.

Hello Peter, yes that is what it should do. I have pasted a Screenshot of my Database page. Row 1 contains the data which is pulled from the non contigious ranges.
Below are the pattern of the ranges, which do not work with Code2 from Peter but with the original code - but as I said, now in wrong order because of the areas, i guess ...

 

[Markus71]

It resolves the problem with 255 char limit & keep the range order intact.
You can uncomment this line:
Debug.Print r.Address
to see the order of the range address in the immediate window.

Yes Akuini, the character limit was the beginning of my problem, but with the union fuction, other problems arised, which we tried to tackle here

 

[Peter_SSs]

yes that is what it should do.

That is what it does for me.
Here is my sheet before the Row_To_NonContiguous code has been run. The numbers in row 1 continue consecutively up to 172 in FP1. The colours are only there to help me visually identify the cells in the non-contiguous range.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Database

.. and here is the same sheet after running the Row_To_NonContiguous code.
As far as I understand it, that is exactly what you wanted. Sorry if it is not working at your end.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12												1					44					87					130
13												2	19	27	38		45	62	70	81		88	105	113	124		131	148	156	167
14												3		28	39		46		71	82		89		114	125		132		157	168
15
16												4	20	29	40		47	63	72	83		90	106	115	126		133	149	158	169
17												5	21	30	41		48	64	73	84		91	107	116	127		134	150	159	170
18												6	22	31	42		49	65	74	85		92	108	117	128		135	151	160	171
19												7	23	32	43		50	66	75	86		93	109	118	129		136	152	161	172
20												8	24				51	67				94	110				137	153
21
22												9		33			52		76			95		119			138		162
23												10		34			53		77			96		120			139		163
24												11		35			54		78			97		121			140		164
25												12		36			55		79			98		122			141		165
26												13		37			56		80			99		123			142		166
27
28												14					57					100					143
29												15	25				58	68				101	111				144	154
30												16	26				59	69				102	112				145	155
31
32
33
34												17					60					103					146
35												18					61					104					147
36
Database

 

[Markus71]

That is what it does for me.
Here is my sheet before the Row_To_NonContiguous code has been run. The numbers in row 1 continue consecutively up to 172 in FP1. The colours are only there to help me visually identify the cells in the non-contiguous range.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Database

.. and here is the same sheet after running the Row_To_NonContiguous code.
As far as I understand it, that is exactly what you wanted. Sorry if it is not working at your end.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12												1					44					87					130
13												2	19	27	38		45	62	70	81		88	105	113	124		131	148	156	167
14												3		28	39		46		71	82		89		114	125		132		157	168
15
16												4	20	29	40		47	63	72	83		90	106	115	126		133	149	158	169
17												5	21	30	41		48	64	73	84		91	107	116	127		134	150	159	170
18												6	22	31	42		49	65	74	85		92	108	117	128		135	151	160	171
19												7	23	32	43		50	66	75	86		93	109	118	129		136	152	161	172
20												8	24				51	67				94	110				137	153
21
22												9		33			52		76			95		119			138		162
23												10		34			53		77			96		120			139		163
24												11		35			54		78			97		121			140		164
25												12		36			55		79			98		122			141		165
26												13		37			56		80			99		123			142		166
27
28												14					57					100					143
29												15	25				58	68				101	111				144	154
30												16	26				59	69				102	112				145	155
31
32
33
34												17					60					103					146
35												18					61					104					147
36
Database

Thank you Peter, this is exactly what it should do. There must be a mistake from my side, but I have no idea where. I‘ll start from scratch when I‘m back on my PC.
Again I have to tilt my head for your superlative support in this case and the time you have spent for me.

 

[Markus71]

That is what it does for me.
Here is my sheet before the Row_To_NonContiguous code has been run. The numbers in row 1 continue consecutively up to 172 in FP1. The colours are only there to help me visually identify the cells in the non-contiguous range.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Database

.. and here is the same sheet after running the Row_To_NonContiguous code.
As far as I understand it, that is exactly what you wanted. Sorry if it is not working at your end.

Markus71.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32
2
11
12												1					44					87					130
13												2	19	27	38		45	62	70	81		88	105	113	124		131	148	156	167
14												3		28	39		46		71	82		89		114	125		132		157	168
15
16												4	20	29	40		47	63	72	83		90	106	115	126		133	149	158	169
17												5	21	30	41		48	64	73	84		91	107	116	127		134	150	159	170
18												6	22	31	42		49	65	74	85		92	108	117	128		135	151	160	171
19												7	23	32	43		50	66	75	86		93	109	118	129		136	152	161	172
20												8	24				51	67				94	110				137	153
21
22												9		33			52		76			95		119			138		162
23												10		34			53		77			96		120			139		163
24												11		35			54		78			97		121			140		164
25												12		36			55		79			98		122			141		165
26												13		37			56		80			99		123			142		166
27
28												14					57					100					143
29												15	25				58	68				101	111				144	154
30												16	26				59	69				102	112				145	155
31
32
33
34												17					60					103					146
35												18					61					104					147
36
Database

Peter, just booted my PC and tried it again .... I am a Roooooooooooookie cause I pasted the code in the worksheet instead of the module ...
Your code works great!

Sorry for the confusion and Thank you for your time!!
Markus

 

[Peter_SSs]

Ah, glad you got it sorted. Yes, better in a standard module. However, that issue has pointed out to me that the code does have a slight error.
Please change

MyAr = Range("A1:FP1").Value2

to

MyAr = .Range("A1:FP1").Value2