Count occurences and rows they are on

  • Thread starter Thread starter ste mac
  • Start date Start date
S

ste mac

Hi, I have a range ("B1:U1000") I would like to count how many
times the values between 14060 and 14100 appear and how
many rows the values appear on...

i.e 14068 occurs 6 times in the range, on 4 different rows
14099 occurs 8 times in the range, on 3 different rows

The range and values will be variable.

I am going to incorporate this into some other code so a macro
is best for me.

Thankyou very much to anyone that can help.

ste
 
ste mac said:
Hi, I have a range ("B1:U1000") I would like to count how many
times the values between 14060 and 14100 appear and how
many rows the values appear on...

i.e 14068 occurs 6 times in the range, on 4 different rows
14099 occurs 8 times in the range, on 3 different rows

The range and values will be variable.

I am going to incorporate this into some other code so a macro
is best for me.

Thankyou very much to anyone that can help.

ste
Click to expand...

Hi ste

Here's one way.

CountFrequency(14070) = 12
CountRows(14070) = 5

means that 14070 occurs 12 times in the range
in 5 rows (duplicates in same row are only counted once)


Sub Frequency()
'Leo Heuser, 1 Nov. 2006
Dim CheckRange As Range
Dim CheckRangeValue As Variant
Dim Counter As Long
Dim Counter1 As Long
Dim CountFrequency() As Variant
Dim CountRows() As Double
Dim MaxValue As Double
Dim MinValue As Double
Dim RowColl As Collection


Set CheckRange = Sheets("Sheet1").Range("B1:U1000")

MinValue = 14060
MaxValue = 14100

ReDim CountFrequency(MinValue To MaxValue)
ReDim CountRows(MinValue To MaxValue)

CheckRangeValue = CheckRange.Value

On Error Resume Next

For Counter = 1 To UBound(CheckRangeValue, 1)
Set RowColl = New Collection
For Counter1 = 1 To UBound(CheckRangeValue, 2)
If CheckRangeValue(Counter, Counter1) >= MinValue And _
CheckRangeValue(Counter, Counter1) <= MaxValue Then
CountFrequency(CheckRangeValue(Counter, Counter1)) = _
CountFrequency(CheckRangeValue(Counter, Counter1)) + 1
RowColl.Add Item:=CheckRangeValue(Counter, Counter1), _
key:=CStr(CheckRangeValue(Counter, Counter1))
End If
Next Counter1

For Counter1 = 1 To RowColl.Count
CountRows(RowColl(Counter1)) = CountRows(RowColl(Counter1)) + 1
Next Counter1
Next Counter

On Error GoTo 0

End Sub
 
Back
Top