Count Distinct Value In Row Range

[ibmy]

Hi,

Sample of 100+k rows:

2.15.xlsb
	F	G	H	I
1	B			expected result :
2	1.21244
3	1.21243		1	1
4	1.21244
5	1.21242
6	1.21241
7	1.21240
8	1.21238		4	3
9	1.21237
10	1.21242
11	1.21240
12	1.21237
13	1.21242		3	3
14	1.21241
15	1.21242
16	1.21237
17	1.21237		2	1
18	1.21241
19	1.21241
20	1.21242
21	1.21242
22	1.21224
23	1.21224
24	1.21224		5	3
25	1.21224
26	1.21225
27	1.21237
28	1.21225
29	1.21224
30	1.21225
31	1.21226
32	1.21226
total distinct value

Range = Start Range (Below Current Row : Row x+1) -> End Range (Current Row + Value in Column H)
Example in Row 8:
H8 value is 4 so Count Distinct Value in Colum F in range of : Row 8+1=9 -> Row 8+4=12
Result in Column I, Row 8, I8 which is 3

 

[Akuini]

Try this:

Sub ibmy_1()

Dim i As Long, j As Long, n As Long
Dim va, vb
Dim d As Object

n = Range("F" & Rows.Count).End(xlUp).Row
va = Range("F2:F" & n)
vb = Range("H2:H" & n)
Set d = CreateObject("scripting.dictionary")

For i = 1 To UBound(va, 1)
    If vb(i, 1) <> "" Then
        For j = i + 1 To i + vb(i, 1)
            d(va(j, 1)) = Empty
            vb(i, 1) = d.Count
        Next
        i = i + vb(i, 1)
        d.RemoveAll
    End If
Next

Range("I2").Resize(UBound(vb, 1), 1) = vb
End Sub

 

[ibmy]

@Akuini ,thanks for the code.

May I know what line to change if value in Column H start at row 3.

 

[Akuini]

May I know what line to change if value in Column H start at row 3.

What do you mean?

 

[ibmy]

In Column H, at row 1&2 never exist a number, the earliest number exist is at row 3.

Is these 3 lines need to change? or I miss other line?

va = Range("F3:F" & n)

vb = Range("H3:H" & n)

Range("I3").Resize(UBound(vb, 1), 1) = vb

 

[Akuini]

Is these 3 lines need to change?

Correct.

 

[Vogateer]

Why not create a Function and use it as a formula?

Function UNIQUE_VALUES_IN_ROWS(ROWS_TO_COUNT As Long, COLUMN_START As Range) As Long
    Dim CountRange As Range
   
    Set CountRange = COLUMN_START.Offset(1, 0).Resize(ROWS_TO_COUNT, 1)
    UNIQUE_VALUES_IN_ROWS = WorksheetFunction.Count(WorksheetFunction.Unique(CountRange))
   
End Function

Then you could put the following formula in I8:

=UNIQUE_VALUES_IN_ROWS(H8,F8)