Formula (or code) return the largest number of duplicates in a list.

[L. Howard]

Without using an actual value, how can I return the largest number of repeats in column A.

So if there are 33 "abc"'s, 22 "def"'s, 9 "ghi"'s etc in a very long list, it would return the value 33.

All the while I have no idea what all the values are in column A.

Therefore =COUNTIF(A1:A200,"abc") would be out of the question. Plus one would have to have a formula for each value, right?

Thanks,
Howard

 

[L. Howard]

Without using an actual value, how can I return the largest number of repeats in column A.

So if there are 33 "abc"'s, 22 "def"'s, 9 "ghi"'s etc in a very long list, it would return the value 33.

All the while I have no idea what all the values are in column A.

Therefore =COUNTIF(A1:A200,"abc") would be out of the question. Plus one would have to have a formula for each value, right?

Thanks,
Howard

Okay, I kept looking, this seems to do that.

=MAX(COUNTIF(A$1:A$200,A1:A200))

Sorry, should've looked harder longer.

Howard

 

[L. Howard]

Array entered, the formula works on the sheet.

=MAX(COUNTIF(A$1:A$200,A1:A200))


Trying to set the value to myMax in code errors on the word Countif

Dim myMax As Long
myMax = Application.WorksheetFunction = Max(CountIf("A$1:A$200", "A1:A200"))

Howard

 

[Claus Busch]

Hi Howard,

Am Mon, 8 Dec 2014 21:57:56 -0800 (PST) schrieb L. Howard:

Dim myMax As Long
myMax = Application.WorksheetFunction = Max(CountIf("A$1:A$200", "A1:A200"))

if you want to write a nested worksheetfunction you have to set
"Worksheetfunction"in front of each function:

With WorksheetFunction
mymax=.Max(.Countif....
end with

But array formulas you cannot calculate with worksheetfunction. You have
to do it with Evaluate:

myMax =Evaluate("=Max(CountIf(A1:A200,A1:A200))")

And if you want to know what value it is try it with INDEX:
=INDEX(A:A,MATCH(MAX(COUNTIF(A1:A200,A1:A200)),COUNTIF(A1:A200,A1:A200),0))
This is also an array formula.


Regards
Claus B.

 

[L. Howard]

Thanks Claus,


Using the formula =MAX(COUNTIF(A$1:A$200,A1:A200)) on the worksheet, it tells me the max number of repeats is 12.

If I use 12 in F1 to set k to 12, the code errors on this line.

ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B:B")) - 1, 0)

However, if I use 11 in F1 then the code runs fine, but the return is false as it says "10.33 = 11 times" when I know there are 12 "10.33"'s in column A.

I was trying to set up myMax in the code to prevent an error if F1 was greater than myMax.

But as it is now the error occurs if myMax = F1.

Howard


Sub AnyDupesNumF1()
Dim i As Long, lr As Long, j As Long, k As Long
Dim vArray As Variant, varOut() As Variant
Dim myMax As Long

[B:B,C:C].ClearContents

'With WorksheetFunction
' myMax = Evaluate("=Max(CountIf(A1:A200,A1:A200))")
'End With
' MsgBox myMax

With Sheets("Sheet1")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
vArray = .Range("A1:A" & lr)
k = .Range("F1")

For i = 2 To UBound(vArray)
If vArray(i, 1) = vArray(i - 1, 1) Then
j = j + 1
If j = k Then
.Cells(i - 1, 2) = vArray(i, 1) & " = " & j & " times"
j = 0
End If
Else
j = 0
End If
Next 'i

lr = .Cells(Rows.Count, 2).End(xlUp).Row
vArray = .Range("B1:B" & lr)
k = 0

ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B:B")) - 1, 0)
For i = LBound(vArray) To UBound(vArray)
If Len(vArray(i, 1)) > 0 Then
varOut(k, 0) = vArray(i, 1)
k = k + 1
End If
Next
.Range("C1").Resize(k) = varOut
End With
End Sub

 

[Claus Busch]

Hi Howard,

Am Mon, 8 Dec 2014 23:29:39 -0800 (PST) schrieb L. Howard:

[B:B,C:C].ClearContents

here you clear B:B

'With WorksheetFunction
' myMax = Evaluate("=Max(CountIf(A1:A200,A1:A200))")
'End With
' MsgBox myMax

With Sheets("Sheet1")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
vArray = .Range("A1:A" & lr)
k = .Range("F1")

For i = 2 To UBound(vArray)
If vArray(i, 1) = vArray(i - 1, 1) Then
j = j + 1
If j = k Then
.Cells(i - 1, 2) = vArray(i, 1) & " = " & j & " times"
j = 0
End If
Else
j = 0
End If
Next 'i

But you write nothing to B. So vArray = empty

lr = .Cells(Rows.Count, 2).End(xlUp).Row
vArray = .Range("B1:B" & lr)
k = 0

ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B:B")) - 1, 0)

CountA(Range("B:B")) = 0

please tell me in words what you want to do.


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Mon, 8 Dec 2014 23:29:39 -0800 (PST) schrieb L. Howard:

Using the formula =MAX(COUNTIF(A$1:A$200,A1:A200)) on the worksheet, it tells me the max number of repeats is 12.

you can get all unique items and the count of them in column a in this
way:

Sub Dupes()
Dim varIn As Variant, varTemp As Variant, varOut() As Variant
Dim LRow As Long, i As Long, n As Long
Dim myDic As Object

Set myDic = CreateObject("Scripting.Dictionary")

With Sheets("Sheet1")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varIn = .Range("A1:A" & LRow)
'Creates unique items
For i = LBound(varIn) To UBound(varIn)
myDic(varIn(i, 1)) = varIn(i, 1)
Next
'array with uniqze items
varTemp = myDic.items

For i = LBound(varTemp) To UBound(varTemp)
ReDim Preserve varOut(myDic.Count, 1)
'Creates an array with the unique items and the count
'of them in column A
varOut(n, 0) = varTemp(i)
varOut(n, 1) = WorksheetFunction.CountIf(.Range("A1:A200"), varTemp(i))
n = n + 1
Next
'Writes the unique items and the count of them to columns C
.Range("C1").Resize(myDic.Count, 2) = varOut
End With
End Sub



Regards
Claus B.

 

[L. Howard]

please tell me in words what you want to do.

The values in column A are temperatures listed at a given interval. The user enters the value in F1. If he wants to know how many times the temp was the same for 11 "intervals" (days hours or what ever the interval is) then F1 is set to 11.

The code finds any entry in column A that occurs consecutively the number of time as F1's value and posts it in column B at the cell where the 11th occurrence is. So in column B there are a number of scattered entries that look like "10.22 = 11 times" or "9.15 = 11 times" etc.

Then all those values in column B are consolidated in column C for easy reading, instead of having to scroll down many rows/pages.

B & C are cleared to ready the code to re-write new info to them with the next F1 query.

I am trying to error trap if F1 is set higher than any number of consecutive temps in column A.

But it is erring at a number 1 less than the max occurrence in A.

Howard

 

[Claus Busch]

Hi Howard,

Am Tue, 9 Dec 2014 00:13:28 -0800 (PST) schrieb L. Howard:

The values in column A are temperatures listed at a given interval. The user enters the value in F1. If he wants to know how many times the temp was the same for 11 "intervals" (days hours or what ever the interval is) then F1 is set to 11.

The code finds any entry in column A that occurs consecutively the number of time as F1's value and posts it in column B at the cell where the 11th occurrence is. So in column B there are a number of scattered entries that look like "10.22 = 11 times" or "9.15 = 11 times" etc.

Then all those values in column B are consolidated in column C for easy reading, instead of having to scroll down many rows/pages.

try:

Sub AnyDupesNumF1()
Dim i As Long, lr As Long, j As Long, k As Long
Dim vArray As Variant, varOut() As Variant

[B:C].ClearContents

With Sheets("Sheet1")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
vArray = .Range("A1:A" & lr)
k = .Range("F1")

For i = 2 To UBound(vArray)
If vArray(i, 1) = vArray(i - 1, 1) Then
j = j + 1
If j = k Then
.Cells(i - 1, 2) = vArray(i, 1) & " = " & j
j = 0
End If
Else
j = 0
End If
Next 'i

lr = .Cells(Rows.Count, 2).End(xlUp).Row
vArray = .Range("B1:B" & lr)
k = 0

ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B:B")) - 1, 0)
For i = LBound(vArray) To UBound(vArray)
If Len(vArray(i, 1)) > 0 Then
varOut(k, 0) = vArray(i, 1)
k = k + 1
End If
Next
.Range("C1").Resize(k) = varOut
End With
End Sub

or try in C1 a formula:

=IFERROR(INDIRECT("B"&SMALL(IF(B1:B2000<>"",ROW(1:2000)),ROW(A1))),"")
and insert the formula with CTRL+Shift+Enter


Regards
Claus B.

 

[L. Howard]

F1 is the query value
F2 is the formula value of the max consecutive occurrences.

I still get an error when F1 is = to the Value in F2.
If F1 is one less than F2 then it runs okay. But gives a false return.


https://www.dropbox.com/s/73vlatpid33ggae/A Column Consecutive entries.xlsm?dl=0

The button has the last code you posted on it has XX in the sub title.

Howard

 

[Claus Busch]

Hi Howard,

Am Tue, 9 Dec 2014 00:52:09 -0800 (PST) schrieb L. Howard:

F1 is the query value
F2 is the formula value of the max consecutive occurrences.

I still get an error when F1 is = to the Value in F2.
If F1 is one less than F2 then it runs okay. But gives a false return.

there is a problem with the table layout. For the first entry j has to
be 1 and the result has to be in cells(i,2). For all other entries j has
to be 0 and the result has to be in cells(i-1,2)
It is easier to do it with a formula. Look here:
https://onedrive.live.com/?cid=9378...#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for your workbook and activate the sheet "Formula".
There you get a result changing F1 without running a macro.


Regards
Claus B.

 

[L. Howard]

There you get a result changing F1 without running a macro.

Very nice!!

Thanks for the help. Never occurred to me that could be done with formulas.

Regards,
Howard

 

[Claus Busch]

Hi Howard,

Am Tue, 9 Dec 2014 02:29:27 -0800 (PST) schrieb L. Howard:

Never occurred to me that could be done with formulas.

if you want do it with a macro you have to go another way.
Try:

Sub Duplicates()
Dim LRow As Long, i As Long, Start As Long, n As Long, k As Long
Dim varOut() As Variant, varTemp As Variant

With Sheets("Sheet1")
.Range("B:C").ClearContents
k = .Range("F1")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Start = 1
Do
If WorksheetFunction.CountIf(.Range(.Cells(Start, 1), _
.Cells(Start + k - 1, 1)), .Cells(Start, 1)) = k Then
.Cells(Start + k - 1, 2) = .Cells(Start, 1) & _
" = " & k & " items"
Start = Start + k
Else
Start = Start + 1
End If
Loop While Start <= LRow

LRow = .Cells(Rows.Count, 2).End(xlUp).Row
varTemp = .Range("B1:B" & LRow)
ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B1:B" & LRow))
- 1, 0)
For i = LBound(varTemp) To UBound(varTemp)
If Len(varTemp(i, 1)) > 0 Then
varOut(n, 0) = varTemp(i, 1)
n = n + 1
End If
Next
.Range("C1").Resize(UBound(varOut) + 1) = varOut
End With

End Sub


Regards
Claus B.

 

[L. Howard]

That is great having both formula and VBA.

On my computer both run in about 16 to 20 seconds, and I assume with 13000+ rows that is quite reasonable given the calc's it is doing.

The first 9 rows on the formula sheet column B have no formulas, I assume that has to do with the use of OFFSET in the formula. Just guessing on my part, but why would it be nine rows?

Thanks for the nice work.

Howard

 

[Claus Busch]

Hi Howard,

Am Tue, 9 Dec 2014 07:19:25 -0800 (PST) schrieb L. Howard:

On my computer both run in about 16 to 20 seconds, and I assume with 13000+ rows that is quite reasonable given the calc's it is doing.

the code is faster if you delete the formula column

The first 9 rows on the formula sheet column B have no formulas, I assume that has to do with the use of OFFSET in the formula. Just guessing on my part, but why would it be nine rows?

If OFFSET becomes negative you get an error. Cells F1 value + 1 rows
must be without formula. If you want each second entry you can drag the
formula to B3. If you want each 10th entry code in Worksheet_Change
deletes the formula from row 1 to 11 to avoid the error.


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Tue, 9 Dec 2014 16:26:31 +0100 schrieb Claus Busch:

the code is faster if you delete the formula column

if you write Appliation.ScreenUpdating = false
the code will also a little bit faster.


Regards
Claus B.

 

[L. Howard]

Hi again,

Am Tue, 9 Dec 2014 16:26:31 +0100 schrieb Claus Busch:


if you write Appliation.ScreenUpdating = false
the code will also a little bit faster.

I did both of those suggestions and the time is about half.

Good stuff and many thanks.

Howard