Lowest repeatable number in a range

R

Riddler

I am trying to come up with a function or some way to return the lowest
repeatable number in a range of numbers. Here is a function that I
have. It works but does not look pretty. Does anyone have a better
routine or idea to acomplish this?

Thanks
Scott

Function LowestRepeatableNumber(myRange As Range)
Dim LastCount As Integer
Dim LowestNumber
LastCount = 0
LowestNumber = Application.WorksheetFunction.Max(myRange)
For Each Value In myRange
If Value = 0 Then GoTo 10
b = Application.WorksheetFunction.CountIf(myRange, Value)
If b > 2 And Value < LowestNumber Then
LowestNumber = Value
End If
10 Next Value
LowestRepeatableNumber = LowestNumber
End Function
 
G

Guest

The logic is good but the syntax could be cleaned up a little. Be sure to
declare all of your variables and the return value of your function. Try to
avoid Goto's as they can make things very convoluted. Beyond that I would not
use Value as a variable as it is a reserved word in VBA... So something more
like this

Function LowestRepeatableNumber(myRange As Range) As Long
Dim LowestNumber As Long
Dim Cell As Range
Dim Count As Long

LowestNumber = Application.WorksheetFunction.Max(myRange)
For Each Cell In myRange
If Cell <> 0 Then
Count = Application.WorksheetFunction.CountIf(myRange, Cell.Value)
If Count > 2 And Cell.Value < LowestNumber Then
LowestNumber = Cell.Value
End If
End If
Next Cell
LowestRepeatableNumber = LowestNumber
End Function
 
R

Riddler

Thanks for the help. I was just wanting to make sure that I was not
overlooking some function or method that would better solve this
problem or make it cleaner looking.

Scott
 
R

RB Smissaert

What is it supposed to do or what exactly is the lowest repeatable number?
It is the repeatable bit I don't get.

RBS
 
R

Riddler

What I am looking to return is the lowest number in a range that
repeats but not zero. Like if you have the following:
2
3
5
4
3
3
6
8
3
0
0
0


I want it to return 3
2 is the lowest number(excluding zero) but it only occurs once. I dont
care if it repeats more than twice just as long as it is the lowest.
I use this for timing sheets where we time processes and then we use
the lowest repeating timing that we opserved for a process.

Scott
 
R

RB Smissaert

OK, I got it.
This is another way then:

Function LowestRepeatedNumberInRange(rngRange As Range) As Long

Dim i As Long
Dim lMin As Long
Dim collDupTest As Collection
Dim arr

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(rngRange)

On Error Resume Next
For i = 1 To UBound(arr)
If arr(i, 1) > 0 Then
If arr(i, 1) < lMin Then
collDupTest.Add arr(i, 1), CStr(arr(i, 1))
If Err.Number <> 0 Then
lMin = arr(i, 1)
End If
End If
End If
Next

LowestRepeatedNumberInRange = lMin

End Function

RBS
 
R

Riddler

My logic in the above functions has some problems. The function below
has better logic to it. It will return "" is there is no matching
lowest repeatable number and exclude zeros.

Function LowestRepeatableNumber(myRange As Range)
Dim LowestNumber
LowestNumber = ""
For Each Cell In myRange
If Cell <> 0 Then
If Application.WorksheetFunction.CountIf(myRange, Cell) >=
2 Then
If Cell < LowestNumber Then LowestNumber = Cell
End If
End If
Next Cell
LowestRepeatableNumber = LowestNumber
End Function


Scott
 
R

Riddler

I ran your (LowestRepeatedNumberInRange) function and it returned the
highest number in a range only.
Like Range( 0,0,2,3,2,4) it returned 4


Scott
 
B

Bernie Deitrick

Scott,

Function LowestRepeatableNumber(myRange As Range)
LowestRepeatableNumber = Evaluate("MIN(IF(" & myRange.Address & ">0," & _
"IF(COUNTIF(" & myRange.Address & "," & myRange.Address & ")>1," & _
myRange.Address & ")))")
End Function

Or use this version if negative numbers are allowed:

Function LowestRepeatableNumber(myRange As Range)
LowestRepeatableNumber = Evaluate("MIN(IF(" & myRange.Address & "<>0," & _
"IF(COUNTIF(" & myRange.Address & "," & myRange.Address & ")>1," & _
myRange.Address & ")))")
End Function


HTH,
Bernie
MS Excel MVP
 
G

Guest

That surproses me. There might be a slight advantage to the Goto but the lack
of declarations should drag the speed down as the varaibles end up as
variants. If Speed is the overriding factor then keep the goto (Shudder) but
declare the variables.

Breaking the rules some times makes things go faster. The toughest rule to
master is when to break the rules. Just my two cents...
 
R

RB Smissaert

Works fine here.
Maybe you had a horizontal, one row range.
I tested with a vertical, one column range.

RBS
 
G

Guest

this should fix it:

Function LowestRepeatableNumber3(rngRange As Range) As Long

Dim i As Long
Dim lMin As Long
Dim collDupTest As Collection
Dim arr

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(rngRange)

On Error Resume Next
For i = 1 To UBound(arr)
If arr(i, 1) > 0 Then
If arr(i, 1) < lMin Then
collDupTest.Add arr(i, 1), CStr(arr(i, 1))
If Err.Number <> 0 Then
lMin = arr(i, 1)
End If
Err.Clear
End If
End If
Next

LowestRepeatableNumber3 = lMin

End Function
 
R

RB Smissaert

Try this one:

Function LowestRepeatedNumberInRange(rngRange As Range) As Long

Dim i As Long
Dim lMin As Long
Dim collDupTest As Collection
Dim arr

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(rngRange)

If rngRange.Rows.Count = 1 Then
arr = WorksheetFunction.Transpose(arr)
End If

On Error Resume Next
For i = 1 To UBound(arr)
If arr(i, 1) > 0 Then
If arr(i, 1) < lMin Then
collDupTest.Add arr(i, 1), CStr(arr(i, 1))
If Err.Number <> 0 Then
lMin = arr(i, 1)
End If
End If
End If
Next

LowestRepeatedNumberInRange = lMin

End Function

You don't really need to transfer to an array, but I was thinking about
making
it as fast as possible. To get the lowest repeated number is easy, but to
get it as fast
as possible is more interesting. Of course you may only have a small range
and speed
may not matter.

RBS
 
B

Bernie Deitrick

This version will return "" if there are no repeats:

Function LowestRepeatableNumber(myRange As Range)
LowestRepeatableNumber = Evaluate("MIN(IF(" & myRange.Address & ">0," & _
"IF(COUNTIF(" & myRange.Address & "," & myRange.Address & ")>1," & _
myRange.Address & ")))")
If LowestRepeatableNumber = 0 Then LowestRepeatableNumber = ""
End Function

HTH,
Bernie
MS Excel MVP
 
R

RB Smissaert

This is a better one:

Function LowestRepeatedNumberInRange2(rngRange As Range) As Long

Dim r As Long
Dim c As Long
Dim arr
Dim lCurrent As Long
Dim lMin As Long
Dim collDupTest As Collection

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(arr)

On Error Resume Next
For r = 1 To UBound(arr)
For c = 1 To UBound(arr, 2)
lCurrent = arr(r, c)
If lCurrent < lMin Then
If lCurrent > 0 Then
collDupTest.Add lCurrent, CStr(lCurrent)
If Err.Number <> 0 Then
lMin = lCurrent
End If
End If
End If
Next
Next

LowestRepeatedNumberInRange2 = lMin

End Function

By rearranging the order of the If conditions you could make it faster,
depending on your expected data.


RBS
 
R

RB Smissaert

Just for in case there are no duplicates, presuming that
there won't be negative numbers:

Function LowestRepeatedNumberInRange2(rngRange As Range) As Long

Dim r As Long
Dim c As Long
Dim arr
Dim lCurrent As Long
Dim lMin As Long
Dim collDupTest As Collection
Dim bDupFound As Boolean

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(arr)

On Error Resume Next
For r = 1 To UBound(arr)
For c = 1 To UBound(arr, 2)
lCurrent = arr(r, c)
If lCurrent < lMin Then
If lCurrent > 0 Then
collDupTest.Add lCurrent, CStr(lCurrent)
If Err.Number <> 0 Then
lMin = lCurrent
bDupFound = True
End If
End If
End If
Next
Next

If bDupFound Then
LowestRepeatedNumberInRange2 = lMin
Else
LowestRepeatedNumberInRange2 = -1
End If

End Function

I have done a bit of speed testing and I believe that a function such as the
above is
very much faster than one based on worksheet functions.
In case you wanted to test use something like this:

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lStartTime As Long

Sub StartSW()
lStartTime = timeGetTime()
End Sub

Sub StopSW(Optional ByRef strMessage As Variant = "")
MsgBox "Done in " & timeGetTime() - lStartTime & " msecs", , strMessage
End Sub


Sub test()

Dim i As Long
Dim lResult As Long

StartSW

For i = 0 To 1000
'lResult = LowestRepeatableNumber(Selection)
lResult = LowestRepeatedNumberInRange2(Selection)
Next

StopSW

MsgBox lResult

End Sub


RBS
 
R

RB Smissaert

Actually doing this is marginally faster:

Function LowestRepeatedNumberInRange4(rngRange As Range) As Long

Dim r As Long
Dim c As Long
Dim arr
Dim lMin As Long
Dim collDupTest As Collection
Dim bDupFound As Boolean

arr = rngRange
Set collDupTest = New Collection
lMin = WorksheetFunction.Max(arr)

On Error Resume Next
For r = 1 To UBound(arr)
For c = 1 To UBound(arr, 2)
If arr(r, c) < lMin Then
If arr(r, c) > 0 Then
collDupTest.Add arr(r, c), CStr(arr(r, c))
If Err.Number <> 0 Then
lMin = arr(r, c)
bDupFound = True
End If
End If
End If
Next
Next

If bDupFound Then
LowestRepeatedNumberInRange4 = lMin
Else
LowestRepeatedNumberInRange4 = -1
End If

End Function


RBS
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Custom function acting weird 2
How to temp disable Worksheet_Change Event while code in same completes? 4
Find and loop help-multiple columns 3
Copy user selected range from all open workbooks 2
[VBA] SUM RANGE OF VALUES 3
How to create a function? 2
Resize Table Range to exclude zero values and Input New Range into achart object 10
VBA Sum returns Wrong Format 7

Top