Finding smallest numbers

  • Thread starter Thread starter Mike7
  • Start date Start date
M

Mike7

Hi.
I need help to automate this peace of work with VBA code. Hope someon
will help me.
Links to screenshot if it not appear
http://img15.imgspot.com/u/05/353/16/Untitled211135113951.gif
mirror
http://img430.imageshack.us/img430/9844/untitled215ck.gif

The source range is B2:K46 (45 rows) and the range of second bloc
where the results must appear is M2:V46 (already with results o
picture).
Generally I need to find 5 smallest numbers in every row and get the
as value 1 in matching rows of second block. Non smallest numbers
value 0.
But it happens not always when the number of smallest numbers is 5
Bellow I described criteria for all possible cases. For bette
understanding I marked in red color the smallest numbers which ar
valid and will get value 1 (I will call them primary smallest numbers)
and in blue color - numbers which are not valid because together wit
primary smallest numbers number of them reaches over 5 (I will cal
them secondary smallest numbers). They will get value 0.
*Case 1* . An ideal case - 5 smallest numbers.
*Case 2* . In this case we have four primary smallest numbers 1,2,2,3
Can't add one more because the next in order are two (or more) the sam
numbers (4 and 4)
*Case 3* . Three primary smallest numbers 3,4,4. Can't add two mor
because the next three (or more) are the same (6,6,6).
*Case 4* . Two primary smallest numbers 1,2. Can't add three mor
because the
next four (or more) are the same (3,3,3,3).
*Case 5* . The rule changes here. Only one smallest number (3) and fiv
next in order numbers (4,4,4,4,4). They all six will get value 1.
*Case 6* . Only one smallest number (6) and six next in order number
(7,7,7,7,7,7). All seven will get value 1.
*Cases 7,8,9* . The rule turns back. If the smallest number is uniqu
and more than six next in order numbers are the same, then only tha
one smallest will get value 1.
*Cases 10,11,12,13,14* . More than five the same smallest numbers. Al
will get value 1.

Thanks

+-------------------------------------------------------------------
|Filename: table1.gif
|Download: http://www.excelforum.com/attachment.php?postid=4142
+-------------------------------------------------------------------
 
Are you testing for these two conditions?
a.. If array is empty, SMALL returns the #NUM! error value.
a.. If k ? 0 or if k exceeds the number of data points, SMALL returns the
#NUM! error value.

What's the thinking here?
 
Mike7

Try this:

Sub FindSmallestNumbers()

Dim nums(2, 10) As Integer
Dim x As Variant
Dim rng As Range

With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 2).End(xlUp).Row
For r = 2 To lastrow
mncount = 0
Set rng = .Range(Cells(r, 2), Cells(r, 11))
rng.Offset(0, 11).Resize(1, 10) = 0
x = rng
nx = 0
Do
mn = Application.Min(x)
nx = nx + 1
nums(1, nx) = mn
nums(2, nx) = Application.CountIf(rng, mn)
For i = 1 To rng.Count
If rng(i).Value = mn Then x(1, i) = 99
Next i
Loop Until Application.Min(x) = 99


If nums(2, 1) >= 5 Then
Call setpointers(nums(1, 1), rng)
Else
If nums(2, 1) = 1 And nums(2, 2) > 6 Then
Call setpointers(nums(1, 1), rng)
Else
If nums(2, 1) = 1 And nums(2, 2) = 5 Then
Call setpointers(nums(1, 1), rng)
Call setpointers(nums(1, 2), rng)
Else
If nums(2, 1) = 1 And nums(2, 2) = 6 Then
Call setpointers(nums(1, 1), rng)
Call setpointers(nums(1, 2), rng)
Else
mncount = 0
nx = 1
mncount = mncount + nums(2, nx)
Do
Call setpointers(nums(1, nx), rng)
nx = nx + 1
mncount = mncount + nums(2, nx)
Loop Until mncount > 5
End If
End If
End If
End If
Next r
End With
End Sub

Sub setpointers(mn, rnga)
For i = 1 To 10
If rnga(i).Value = mn Then rnga(i).Offset(0, 11) = 1
Next i
End Sub
 
Back
Top