Code to get data from data 10 lines away get 1 line

[Excelpromax123]

Hello everyone. I have a data range A1:B10000. I want to get 1 row every 10 lines to output column D, C. so that the code runs as fast as possible. Sincerely thank

VBA GET 10 TO 1.xlsm

drive.google.com

 

[offthelip]

try this:

Sub test()
inarr = Range("a1:d10000")
Dim outarr(1 To 1000, 1 To 4)
indi = 1
For i = 1 To 10000 Step 10
 outarr(indi, 1) = inarr(i, 1)
 outarr(indi, 2) = inarr(i, 2)
 outarr(indi, 3) = inarr(i, 3)
 outarr(indi, 4) = inarr(i, 4)
 indi = indi + 1
Next i
Range("h1:k100") = outarr

 
End Sub

note how easy it is to change the ranges if you use absolute addressing, since learning how to use variant arrays is the easiest way to learn how to write fast vba code. It worth looking at how simple it can be to use variant arrays. The extra time taken to loop through a load of empty rows is insignificant compared to the saving in learning how NOT to loop through a worksheet

 

[Excelpromax123]

I would edit the code to something like:

Sub test()
    Dim iVar As Variant, oVar() As Variant, x As Long, z As Long
 
    iVar = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim oVar(UBound(iVar) / 10, UBound(iVar, 2) - 1)
 
    For x = 1 To UBound(iVar) Step 10
        oVar(z, 0) = iVar(x, 1)
        oVar(z, 1) = iVar(x, 2)
        oVar(z, 2) = iVar(x, 3)
        oVar(z, 3) = iVar(x, 4)
        z = z + 1
    Next x
 
    Range("H1").Resize(UBound(oVar) + 1, UBound(oVar, 2) + 1) = oVar
End Sub

I have made the ReDim part to be dynamic to the range size 'iVar'
I have also changed the last line of code to be dynamic to the size of the output array 'oVar'

Thank You

 

[Georgiboy]

Probably no use to you but I do love Excel 365 as an 365 option could be something like the below:

VBA GET 10 TO 1 (1).xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	1	A1	B1	C1				1	A1	B1	C1
2	2	A2	B2	C2				11	A11	B11	C11
3	3	A3	B3	C3				21	A21	B21	C21
4	4	A4	B4	C4				31	A31	B31	C31
5	5	A5	B5	C5				41	A41	B41	C41
6	6	A6	B6	C6				51	A51	B51	C51
7	7	A7	B7	C7				61	A61	B61	C61
8	8	A8	B8	C8				71	A71	B71	C71
9	9	A9	B9	C9				81	A81	B81	C81
10	10	A10	B10	C10				91	A91	B91	C91
11	11	A11	B11	C11
12	12	A12	B12	C12
13	13	A13	B13	C13
14	14	A14	B14	C14
15	15	A15	B15	C15
16	16	A16	B16	C16
17	17	A17	B17	C17
18	18	A18	B18	C18
19	19	A19	B19	C19
20	20	A20	B20	C20
21	21	A21	B21	C21
22	22	A22	B22	C22
23	23	A23	B23	C23
24	24	A24	B24	C24
25	25	A25	B25	C25
26	26	A26	B26	C26
27	27	A27	B27	C27
28	28	A28	B28	C28
29	29	A29	B29	C29
30	30	A30	B30	C30
31	31	A31	B31	C31
32	32	A32	B32	C32
33	33	A33	B33	C33
34	34	A34	B34	C34
35	35	A35	B35	C35
36	36	A36	B36	C36
37	37	A37	B37	C37
38	38	A38	B38	C38
39	39	A39	B39	C39
40	40	A40	B40	C40
41	41	A41	B41	C41
42	42	A42	B42	C42
43	43	A43	B43	C43
44	44	A44	B44	C44
45	45	A45	B45	C45
46	46	A46	B46	C46
47	47	A47	B47	C47
48	48	A48	B48	C48
49	49	A49	B49	C49
50	50	A50	B50	C50
51	51	A51	B51	C51
52	52	A52	B52	C52
53	53	A53	B53	C53
54	54	A54	B54	C54
55	55	A55	B55	C55
56	56	A56	B56	C56
57	57	A57	B57	C57
58	58	A58	B58	C58
59	59	A59	B59	C59
60	60	A60	B60	C60
61	61	A61	B61	C61
62	62	A62	B62	C62
63	63	A63	B63	C63
64	64	A64	B64	C64
65	65	A65	B65	C65
66	66	A66	B66	C66
67	67	A67	B67	C67
68	68	A68	B68	C68
69	69	A69	B69	C69
70	70	A70	B70	C70
71	71	A71	B71	C71
72	72	A72	B72	C72
73	73	A73	B73	C73
74	74	A74	B74	C74
75	75	A75	B75	C75
76	76	A76	B76	C76
77	77	A77	B77	C77
78	78	A78	B78	C78
79	79	A79	B79	C79
80	80	A80	B80	C80
81	81	A81	B81	C81
82	82	A82	B82	C82
83	83	A83	B83	C83
84	84	A84	B84	C84
85	85	A85	B85	C85
86	86	A86	B86	C86
87	87	A87	B87	C87
88	88	A88	B88	C88
89	89	A89	B89	C89
90	90	A90	B90	C90
91	91	A91	B91	C91
92	92	A92	B92	C92
93	93	A93	B93	C93
94	94	A94	B94	C94
95	95	A95	B95	C95
96	96	A96	B96	C96
97	97	A97	B97	C97
98	98	A98	B98	C98
99	99	A99	B99	C99
100	100	A100	B100	C100
Sheet1

Cell Formulas
Range	Formula
H1:K10	H1	=FILTER(A1:D100,--RIGHT(A1:A100,1)=1)
Dynamic array formulas.

 

[Excelpromax123]

try this:

Sub test()
inarr = Range("a1:B10000")
Dim outarr(1 To 1000, 1 To 2)
indi = 1
For i = 1 To 10000 Step 10
 outarr(indi, 1) = inarr(i, 1)
 outarr(indi, 2) = inarr(i, 2)
 indi = indi + 1
Next i
Range("d1:e100") = outarr

 
End Sub

this should be much faster than looping through the workssheet

Thank You

 

[DavePower]

Hi,

I am trying to use the code above for similar VBA for two different scenarios but am getting stuck.
I have tried to look at .PasteSpecial xlPasteValues but finding it difficult.

1st VBA
for all rows A1:B10000 copied over to column D and E.

2nd VBA
For first 50 rows for A1:B10000 copied over to column D and E.

Could someone provide help please.

Thank-you

 

[offthelip]

I virtually never use paste values in vba because I find it less typing to copy to a variant array like this
:

Sub allrowswithvalues()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(LastRow, 2))
Range(Cells(1, 3), Cells(LastRow, 4)) = inarr
End Sub
Sub rows50()
LastRow = 50
inarr = Range(Cells(1, 1), Cells(LastRow, 2))
Range(Cells(1, 3), Cells(LastRow, 4)) = inarr
End Sub

 

[DavePower]

I virtually never use paste values in vba because I find it less typing to copy to a variant array like this
:

Sub allrowswithvalues()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(LastRow, 2))
Range(Cells(1, 3), Cells(LastRow, 4)) = inarr
End Sub
Sub rows50()
LastRow = 50
inarr = Range(Cells(1, 1), Cells(LastRow, 2))
Range(Cells(1, 3), Cells(LastRow, 4)) = inarr
End Sub

Thank-you @offthelip so much for the 2 VBA this really helps, I do have a following up, if I needed to change cells from A1B1 to A3B3 to copy to D3E3 instead of D3E3 where in the VBA would I update this?
Thank-you

 

[offthelip]

The Range addressing system I was using uses row and column numbers instead of a column letter and a row number. Unfortunately for whatever reason EXCEL uses the row and column in the reverse order, ie. row then column, so in my equation :

inarr = Range(Cells(1, 1), Cells(LastRow, 2))

there are 4 numbers which are :

inarr = Range(Cells(startrownumber, startcolumnnumber), Cells(LastRownumber, lastcolumnnumber))

so to change to copy from starting in 1 to starting in row 3 you need change it to

inarr = Range(Cells(3, 1), Cells(LastRow, 2))

you then need to do the same when you write it back to the worksheet :
change:

Range(Cells(1, 3), Cells(LastRow, 4)) = inarr

to

Range(Cells(3, 3), Cells(LastRow, 4)) = inarr