Copy "Value" with row offset of the "Value"

[ibmy]

Hi,

offset copy.xlsb
	F	G
1		expected result
2
3
4		3
5
6	3
7
8	1	1
9
10		2
11	2
12
13
14
15		5
16
17
18
19	5
20
21
22
Sheet1

Result in G4, I was thinking formula of "Row(6)-3 +1" or "Row(6)+1 -3" but do not know how to implement in vba code.
Data of 100k row.

 

[Phuoc]

If in F2 is 3, what is your desired result?

 

[ibmy]

@Phuoc , thanks for reply.

My bad, forgot to add Column E.
Column F is the result of sum of "1" in Column E

offset copy.xlsb
	E	F	G
1			expected result
2
3
4	1		3
5	1
6	1	3
7
8	1	1	1
9
10	1		2
11	1	2
12
13
14
15	1		5
16	1
17	1
18	1
19	1	5
20
21
22
Sheet1

 

[Phuoc]

Try this:

Book1
	E	F	G
1			expected result
2
3
4	1	3	3
5	1
6	1
7
8	1	1	1
9
10	1	2	2
11	1
12
13
14
15	1	5	5
16	1
17	1
18	1
19	1
20
21
22
23
Sheet1

Cell Formulas
Range	Formula
F4:F19	F4	=IF(AND(E4=1,E3=""),SUM(E4:INDEX(E4:$E$30,MATCH(TRUE,E4:$E$30="",0))),"")
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[ibmy]

@Phuoc , thanks for the formula, it work fast on data that have less row but slow on data that have lots of row (100k+ rows) .

If in F2 is 3, what is your desired result?

It never happen because let say E2 to E10 contains "1" so total is 9 in F10, so Row(10)-9 +1 = Row(2)

Right now I have 2 idea:
1. Count/ Sum Column E from last row up to E2
2. Offset Copy row using formula "Row(x)-y +1" or "Row(x)+1 -y" ; y=value

 

[Akuini]

Try this:

Sub ibmy_1()
' group looping

Dim i As Long, j As Long, h As Long
Dim va, vb
Dim t As Double

t = Timer
va = Range("E1", Cells(Rows.Count, "E").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
h = UBound(va, 1)

For i = 2 To h
 j = i
    Do
        i = i + 1
        If i > h Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    i = i - 1
    If va(i, 1) = 1 Then
        vb(j, 1) = i - j + 1
    End If
Next
'result
Range("G1").Resize(UBound(vb, 1), 1) = vb

Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

Book3
	E	F	G
1
2
3
4	1		3
5	1
6	1
7
8	1		1
9
10	1		2
11	1
12
13
14
15	1		5
16	1
17	1
18	1
19	1
Sheet2

 

[ibmy]

@Akuini , thanks, the code works great.

May I know what line in code need to change if I want the result in Column F?

 

[Akuini]

@Akuini , thanks, the code works great.

May I know what line in code need to change if I want the result in Column F?

'result
Range("F1").Resize(UBound(vb, 1), 1) = vb

 

[ibmy]

@Akuini ,

8.30.xlsb
	E	F
1		expected result :
2		3
3	1
4	1
5	1
6		1
7	1
8		2
9	1
10	1
11
12
13		5
14	1
15	1
16	1
17	1
18	1
19
Sheet7

What to change in code to produce result in 1 up cell?
Currently I add this line at the end of code.

Range("F2").Select
Selection.Delete Shift:=xlUp

Sub ResultF_start()
' group looping

Dim i As Long, j As Long, h As Long
Dim va, vb

va = Range("E1", Cells(Rows.Count, "E").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
h = UBound(va, 1)

For i = 2 To h
 j = i
    Do
        i = i + 1
        If i > h Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    i = i - 1
    If va(i, 1) = 1 Then
        vb(j, 1) = i - j + 1
    End If
Next

'result
Range("F1").Resize(UBound(vb, 1), 1) = vb

Range("F2").Select
Selection.Delete Shift:=xlUp

Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"

End Sub

 

[Akuini]

What to change in code to produce result in 1 up cell?

In my code on post #6, just change this part:

vb(j, 1) = i - j + 1

to this:

vb(j - 1, 1) = i - j + 1