Macro to copy data from one layout to another layout

[JannetteChristie]

Can anyone help with this please, I am trying to write some VBA to copy the following data in my spreadsheet to move to this format.

Starting layout:

Excel 2012
	C	D	E	F	G	H	I	J	K	L	M	N	O
2	VR3-0510-LHM	DUTYPOINT	3	FS5-WRAS	1	COMM1	1	FRB50	2
3	DE		0
4	qp-35	PRESSURISATION	0
5	ec50	CONDITIONER	2	DPS-WMB-EC50	2	DPS-FMB-EC50	1
6	cx65c	SEP	0
7	in15-50-p-h2	HIU	0
8	DPS-SP		1	DPS-NOTE	1
9
10
11
12
13
14
Save & Print prepare

New layout required:

Excel 2012
	T	U
2	VR3-0510-LHM
3	FS5-WRAS	1
4	COMM1	1
5	FRB50	2
6	DE
7	QP-35
8	EC50
9	DPS-WMB-EC50	2
10	DPS-FMB-EC50	1
11	cx65c
12	IN15-50-P-H2
13	DPS-SP
14	DPS-NOTE	1
Save & Print prepare

I am sure this is possible but not sure how to code this.

 

[Fluff]

How about

Sub Test()
   Dim ary As Variant, nary As Variant
   Dim r As Long, c As Long, rr As Long
   
   ary = Range("C2", Range("C" & Rows.Count).End(xlUp).Offset(, 8)).Value2
   ReDim nary(1 To UBound(ary) + Application.SUM(Range("E:E")), 1 To 2)
   For r = 1 To UBound(ary)
      rr = rr + 1
      nary(rr, 1) = ary(r, 1)
      If ary(r, 3) > 0 Then
         For c = 1 To ary(r, 3) * 2 Step 2
            rr = rr + 1
            nary(rr, 1) = ary(r, c + 3)
            nary(rr, 2) = ary(r, c + 4)
         Next c
      End If
   Next r
   Range("T2").Resize(rr, 2).Value = nary
   
End Sub

 

[JannetteChristie]

Hi, I have just used this code and it works fine for most of it. However when it gets to the end and finds that ary,3="" I get the error message type mismatch. How do I get over it please?

 

[Fluff]

You wouldn't get that if the cell in col E was blank.
Do you have text in there?

 

[JannetteChristie]

Hi,

I have added an extra column in between D & E, and am trying to also include the data in the new column in the array - ary,4. I have tried to amend the code but some of the data appears to be overwritten and I am not sure how to resolve this.

ary = Range("C2", Range("C" & Rows.Count).End(xlUp).Offset(, 14)).Value2
ReDim nary(1 To UBound(ary) + Application.Sum(Range("G:G")), 1 To 2)
For r = 1 To UBound(ary)
rr = rr + 1
nary(rr, 1) = ary(r, 1)
'nary(rr, 2) = ary(r, 2)

If ary(r, 4) > 0 And ary(r, 4) <> "" Then
nary(rr, 1) = ary(r, 4)
End If

If ary(r, 5) > 0 And ary(r, 5) <> "" Then
For c = 1 To ary(r, 5) * 2 Step 2
rr = rr + 1
nary(rr, 1) = ary(r, c + 3)
nary(rr, 2) = ary(r, c + 4)
Next c
End If
Next r
Range("U2").Resize(rr, 2).Value = nary

 

[Fluff]

Can you please post an example of your new data layout & what you are trying to do?

 

[JannetteChristie]

Excel 2012
	C	D	E	F	G	H	I	J	K	L	M
2	VR3-1006-LHT	1	DUTYPOINT	RECOMMENDED EXTRAS	3	FRB50	1	FRB65	1	FS5-WRAS	1
3	EC50	1	CONDITIONER	RECOMMENDED EXTRAS	2	DPS-WMB-EC50	2	DPS-FMB-EC50	1
4	QP-35	1	PRESSURISATION		0
5	Z500LV	1			0
6	E502070AA	1			0
7	DPS-SP	1			1	DPS-NOTE	1
8	VR2-1005-LHT	1	DUTYPOINT	RECOMMENDED EXTRAS	3	FRB65	1	FRB50	1	FS5-WRAS	1
9	VR4-0506-LHM	1			0
Save & Print prepare

My aim is to get this:

Excel 2012
	U	V
2	VR3-1006-LHT
3	RECOMMENDED EXTRAS
4	FRB50	1
5	FRB65	1
6	FS5-WRAS	1
7	EC50
8	RECOMMENDED EXTRAS
9	DPS-WMB-EC50	2
10	DPS-FMB-EC50	1
11	QP-35
12	Z500LV
13	E502070AA
14	DPS-SP
15	DPS-NOTE	1
16	VR2-1005-LHT
17	RECOMMENDED EXTRAS
18	FRB65	1
19	FRB50	1
20	FS5-WRAS	1
21	VR4-0506-LHM
Save & Print prepare

 

[Fluff]

Ok, how about

Sub Test()
   Dim ary As Variant, nary As Variant
   Dim r As Long, c As Long, rr As Long
   
   ary = Range("C2", Range("C" & Rows.Count).End(xlUp).Offset(, 10)).Value2
   ReDim nary(1 To UBound(ary) + Application.SUM(Range("G:G")) + Application.Count(Range("G:G")), 1 To 2)
   For r = 1 To UBound(ary)
      rr = rr + 1
      nary(rr, 1) = ary(r, 1)
      If ary(r, 5) > 0 Then
         rr = rr + 1
         nary(rr, 1) = ary(r, 4)
         For c = 1 To ary(r, 5) * 2 Step 2
            rr = rr + 1
            nary(rr, 1) = ary(r, c + 5)
            nary(rr, 2) = ary(r, c + 6)
         Next c
      End If
   Next r
   Range("U2").Resize(rr, 2).Value = nary
   
End Sub

 

[JannetteChristie]

Hi,

I have amended the code as per above, but keep getting Run-time error '9': Subscript out of range.

rr=110
r=97

 

[Fluff]

When you get the error, click debug & then in the immediate window type

?ubound(nary)

&hit enter. What value does it give?