VBA Application.WorksheetFunction.Small with condition

[Lres81715]

Hello all you guru's,

I'm trying to find a VBA solution to a problem I'm having where I need to find a succession of lowest numbers not lower than 50.

Application.WorksheetFunction.Small(ActiveSheet.Range("C3:C" & LastRow), 1)

This gives me 2.62 which is indeed the smallest figure in my range. However, I want it to show 50.67 which is the lowest number today in my range. I want to do this for the next 5 smallest numbers. (AKA 50.91, 51.3, 55.6, and 55.6).

Also, if one of you could give me a tip to a follow up question, I have to figure how to correctly return the right row of information into the VLOOKUP equation I'm using from the these 5 results. As in, I don't want the 5th result above to return back the 4th results information because they are the same number.

Thanks!

 

[MUKESHY12390]

could you provide sample data that would give lot easier to understand just one column

 

[Lres81715]

Sure,

This is the Averages for today's figures.
It can vary in size dramatically from 15 rows on up to 175 rows of averages. For the purposes of my report, I only need the bottom 5 > 50.0

[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64, align: right"]122.8462[/TD]
[/TR]
[TR]
[TD="align: right"]269.5385[/TD]
[/TR]
[TR]
[TD="align: right"]161.4615[/TD]
[/TR]
[TR]
[TD="align: right"]25.15385[/TD]
[/TR]
[TR]
[TD="align: right"]31.76923[/TD]
[/TR]
[TR]
[TD="align: right"]61.46154[/TD]
[/TR]
[TR]
[TD="align: right"]22.07692[/TD]
[/TR]
[TR]
[TD="align: right"]6.384615[/TD]
[/TR]
[TR]
[TD="align: right"]40.92308[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]11.61538[/TD]
[/TR]
[TR]
[TD="align: right"]127.2308[/TD]
[/TR]
[TR]
[TD="align: right"]5.153846[/TD]
[/TR]
[TR]
[TD="align: right"]77.53846[/TD]
[/TR]
[TR]
[TD="align: right"]9.692308[/TD]
[/TR]
[TR]
[TD="align: right"]21.69231[/TD]
[/TR]
[TR]
[TD="align: right"]4.846154[/TD]
[/TR]
[TR]
[TD="align: right"]2.615385[/TD]
[/TR]
[TR]
[TD="align: right"]43.38462[/TD]
[/TR]
[TR]
[TD="align: right"]193.8462[/TD]
[/TR]
[TR]
[TD="align: right"]131.3846[/TD]
[/TR]
[TR]
[TD="align: right"]166[/TD]
[/TR]
[TR]
[TD="align: right"]10.53846[/TD]
[/TR]
[TR]
[TD="align: right"]16.15385[/TD]
[/TR]
[TR]
[TD="align: right"]98.3[/TD]
[/TR]
[TR]
[TD="align: right"]258.4[/TD]
[/TR]
[TR]
[TD="align: right"]221.5[/TD]
[/TR]
[TR]
[TD="align: right"]34[/TD]
[/TR]
[TR]
[TD="align: right"]27.13333[/TD]
[/TR]
[TR]
[TD="align: right"]72.93333[/TD]
[/TR]
[TR]
[TD="align: right"]37.26667[/TD]
[/TR]
[TR]
[TD="align: right"]6.466667[/TD]
[/TR]
[TR]
[TD="align: right"]38.56667[/TD]
[/TR]
[TR]
[TD="align: right"]5.2[/TD]
[/TR]
[TR]
[TD="align: right"]11.36667[/TD]
[/TR]
[TR]
[TD="align: right"]89.8[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]70.7[/TD]
[/TR]
[TR]
[TD="align: right"]10.4[/TD]
[/TR]
[TR]
[TD="align: right"]22.2[/TD]
[/TR]
[TR]
[TD="align: right"]5.266667[/TD]
[/TR]
[TR]
[TD="align: right"]6.5[/TD]
[/TR]
[TR]
[TD="align: right"]34.93333[/TD]
[/TR]
[TR]
[TD="align: right"]50.67[/TD]
[/TR]
[TR]
[TD="align: right"]262.1333[/TD]
[/TR]
[TR]
[TD="align: right"]126.2333[/TD]
[/TR]
[TR]
[TD="align: right"]55.6[/TD]
[/TR]
[TR]
[TD="align: right"]155.8333[/TD]
[/TR]
[TR]
[TD="align: right"]11[/TD]
[/TR]
[TR]
[TD="align: right"]16.63333[/TD]
[/TR]
[TR]
[TD="align: right"]133[/TD]
[/TR]
[TR]
[TD="align: right"]276[/TD]
[/TR]
[TR]
[TD="align: right"]131.75[/TD]
[/TR]
[TR]
[TD="align: right"]30.75[/TD]
[/TR]
[TR]
[TD="align: right"]29[/TD]
[/TR]
[TR]
[TD="align: right"]55.6[/TD]
[/TR]
[TR]
[TD="align: right"]70.75[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]5.75[/TD]
[/TR]
[TR]
[TD="align: right"]48[/TD]
[/TR]
[TR]
[TD="align: right"]6.5[/TD]
[/TR]
[TR]
[TD="align: right"]12.75[/TD]
[/TR]
[TR]
[TD="align: right"]140.5[/TD]
[/TR]
[TR]
[TD="align: right"]4.25[/TD]
[/TR]
[TR]
[TD="align: right"]60.5[/TD]
[/TR]
[TR]
[TD="align: right"]5.25[/TD]
[/TR]
[TR]
[TD="align: right"]24.5[/TD]
[/TR]
[TR]
[TD="align: right"]6.75[/TD]
[/TR]
[TR]
[TD="align: right"]3.5[/TD]
[/TR]
[TR]
[TD="align: right"]45[/TD]
[/TR]
[TR]
[TD="align: right"]51.3[/TD]
[/TR]
[TR]
[TD="align: right"]180.25[/TD]
[/TR]
[TR]
[TD="align: right"]130[/TD]
[/TR]
[TR]
[TD="align: right"]167[/TD]
[/TR]
[TR]
[TD="align: right"]12.25[/TD]
[/TR]
[TR]
[TD="align: right"]13.75[/TD]
[/TR]
[TR]
[TD="align: right"]131.75[/TD]
[/TR]
[TR]
[TD="align: right"]30.75[/TD]
[/TR]
[TR]
[TD="align: right"]29[/TD]
[/TR]
[TR]
[TD="align: right"]70.75[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]5.75[/TD]
[/TR]
[TR]
[TD="align: right"]48[/TD]
[/TR]
[TR]
[TD="align: right"]6.5[/TD]
[/TR]
[TR]
[TD="align: right"]12.75[/TD]
[/TR]
[TR]
[TD="align: right"]140.5[/TD]
[/TR]
[TR]
[TD="align: right"]4.25[/TD]
[/TR]
[TR]
[TD="align: right"]60.5[/TD]
[/TR]
[TR]
[TD="align: right"]5.25[/TD]
[/TR]
[TR]
[TD="align: right"]24.5[/TD]
[/TR]
[TR]
[TD="align: right"]6.75[/TD]
[/TR]
[TR]
[TD="align: right"]3.5[/TD]
[/TR]
[TR]
[TD="align: right"]49.115[/TD]
[/TR]
[TR]
[TD="align: right"]50.91[/TD]
[/TR]
</tbody>[/TABLE]

 

[Lres81715]

bump, still looking for a solution to the main problem. The second question I can figure out (I think)

 

[MUKESHY12390]

try this..

Option Explicit


Function GetsmallestValue(ByRef oColumnNo As Long, ByRef GreaterThan As Double)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'How to use this function :
'Step 1 ) Open any excel workbook , Press ALT+ F11 , open any "Module" and paste over entire code


'Step 2 ) goto sheet , select any cell type = GetsmallestValue(columnNumber where your data is stored,50  is your critera you can type different number as well)


'eg :  if you have stored data in column "G" then syntax would be GetsmallestValue(7,50)


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim olastRow As Long
Dim ovalue As Double
Dim i  As Long
Dim ws As Worksheet
Dim osmallestNumber
Dim oSmall()
Dim j As Long
Dim omatchfound As Boolean




omatchfound = False


Set ws = ActiveSheet   '''''' this function takes data reference from activesheet,,,,Also you can type different wroksheet Name  eg. Worksheet("sheet1')


olastRow = Cells(Rows.Count, oColumnNo).End(xlUp).Row
ReDim oSmall(olastRow)
j = 1
For i = 1 To olastRow
    ovalue = ws.Cells(i, oColumnNo).Value
    If ovalue > GreaterThan Then
      oSmall(j) = ovalue
       Debug.Print ovalue
      osmallestNumber = ovalue
      j = j + 1
      omatchfound = True
    End If
Next i




If omatchfound = True Then
  osmallestNumber = WorksheetFunction.Small(oSmall, 1)
  GetsmallestValue = osmallestNumber
Else
GetsmallestValue = "Not Found"
End If


End Function

 

[MUKESHY12390]

earlier one has one bug.... try this

eg: - syntax would be GetsmallestValue(G1:G10,50) ''''''just change "G" column as per need

Function GetsmallestValue(oRng As Range, GreaterThan As Double)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'How to use this function :
'Step 1 ) Open any excel workbook , Press ALT+ F11 , open any "Module" and paste over entire code


'Step 2 ) goto sheet , select any cell type = GetsmallestValue(Select Range where your data is stored,50  is your critera you can type different number as well)


'eg :  if you have stored data in column "G" then syntax would be GetsmallestValue(G1:G10,50)


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim olastRow As Long
Dim ovalue As Variant
Dim i  As Long
Dim ws As Worksheet
Dim osmallestNumber
Dim oSmall()
Dim j As Long
Dim omatchfound As Boolean
Dim ofound As Long
Dim cell As Range
Dim otxtf As String
Dim oTxt_Fnd As Boolean
Dim onmbr_found As Boolean
Dim oreplace_Dcml As Variant
Dim strTemp As String




omatchfound = False


otxt = "Checker"
Set ws = ActiveSheet   '''''' this function takes data reference from activesheet,,,,Also you can type different wroksheet Name  eg. Worksheet("sheet1')


ReDim oSmall(oRng.Count)
j = 1
 For Each cell In oRng
    oTxt_Fnd = False
    onmbr_found = False
    ovalue = cell.Value
    
    oreplace_Dcml = VBA.Replace(Trim(ovalue), ".", "", 1, , vbTextCompare)
    
    
    On Error Resume Next
    On Error GoTo oNext
    ofound = IsNumeric(CDbl(ovalue))
    
    If ofound = -1 Then
      If ovalue > GreaterThan Then
        oSmall(j) = ovalue
        osmallestNumber = ovalue
        j = j + 1
        omatchfound = True
      End If
    End If
    
    If otxtf = "errorValuBxml4564798" Then
oNext:
      'Debug.Print Err.Number & " --" & Err.Description
      On Error GoTo 0
      On Error GoTo -1
    End If
    
Next cell




If omatchfound = True Then
  osmallestNumber = WorksheetFunction.Small(oSmall, 1)
  GetsmallestValue = osmallestNumber
Else
  GetsmallestValue = "Not found"
End If


End Function

 

[Lres81715]

Ok phew,
I thought it was just me on that bug. I'll take a look at this new code soon. Thanks for following up Mukeshy

 

[Lres81715]

MUKESHY,

Thank you for replying and giving me insight on how to proceed. Your method eventually worked but was very complex for my purposes. More likely, I lacked the skills to figure out the logic in your code.
I went ahead and figured out how to do it using a series of clunky but never-the-less effective combinations. I used Named Range, WorksheetFunction and Evaluate. Getting just the >40 condition was part of the equation.
Here's what I did. Bit clunky but it works.

Sub test()

    Dim sh5             As Worksheet
    Dim LastRowW        As Long


    Set sh5 = Sheets("WeeklySummary 2016")


    LastRowW = sh5.Range("A2").CurrentRegion.Rows.Count
    
    sh5.Range("C3:C" & LastRowW - 1).Name = "WEEKSUM13"
    sh5.Range("B3:B" & LastRowW - 1).Name = "WEEKSUMYTD"
    sh5.Range("G3:G" & LastRowW - 1).Name = "WEEKSUMMTD"
    sh5.Range("I3:I" & LastRowW - 1).Name = "WEEKSUMYTDTOTALS"
    
    Rank = 1 'used for a loop which I created in my actual code

' used for testing the basic part of the formula
uptrend1 = Application.WorksheetFunction.Large(sh5.Range("WEEKSUMYTDTOTALS"), Rank)
' First part of the formula that worked.  Rank wouldn't work in Evaluate so I had to use WorksheetFunction.Small first and wrap the IF in []
uptrend2 = Application.WorksheetFunction.Small([IF(WEEKSUM13>40,WEEKSUM13,"")], Rank + 1)
' Second part of the complex portion of the formula. I needed to only show figures on the Rise where Month-To-Date figures were greater than a 13 week trend and Year to Date trend.  AND be greater than 40.  This worked like a charm.

uptrend3 = Application.WorksheetFunction.Small([IF(WEEKSUMMTD>WEEKSUM13,IF(WEEKSUMMTD>WEEKSUMYTD,IF(WEEKSUMMTD>40,WEEKSUMMTD,""),""),"")], Rank)
' Third part was to duplicate the above only show figures on the Decline.  AKA accounts we need to track starting from our Top clients and working our way down.  
uptrend4 = <weeksum13,if(weeksummtd<weeksumytd,if(weeksummtd>Application.WorksheetFunction.Large([IF(WEEKSUMMTD<WEEKSUM13,IF(WEEKSUMMTD<WEEKSUMYTD,IF(WEEKSUMMTD>40,WEEKSUMMTD,""),""),"")], Rank)


End Sub

</weeksum13,if(weeksummtd<weeksumytd,if(weeksummtd>

 

[MUKESHY12390]

I'm glad you find your own solution.

I would like add whenever you writing code always include "Option Explicit" in code , it help you to learn more about object & data type and also helps to find out typo error in code.