Excel-VBA: Finding the 2nd highest value 2

[Excelerate2004]

Is there a function to find the 2nd highest value amongst a range of values?

I have 4 columns, labeled: A, B, C, D.

If I take the Max value of those 4 columns, then subtract the max from each of the individual columns then the lowest resulting value is the 2nd highest.

Is there an easier way to do this?

Thanks,

 

[rmikesmith]

See the LARGE worksheet function. Allows you to specify the k-th largest entry in an array/range.

Regards,
Mike

 

[Excelerate2004]

Awesome, thats a much easier solution than having to use my proposed method above!

Thanks for the time saver!

Cheers!

 

[Excelerate2004]

One question though rmikesmith,

I'm using VBA to code for this worksheet function, however after I execute my code, it places the values as I have stated in my code but I get an error that says:

"Run time error '1004'

Unable to get the Large property of the worksheetfunction class."

Is there any way to avoid this error??

see code below:


Dim Rng As Range
Dim i As Long
Dim rngLastcell As Integer

rngLastcell = Selection.SpecialCells(11).Row

For i = 2 To rngLastcell
Set Rng = Range("G" & i, "J" & i)
Cells(i, "P").Value = WorksheetFunction.Large((Rng), 2)
Next i



Thanks again

 

[PHV]

And what about replacing this:
Set Rng = Range("G" & i, "J" & i)
By this:
Set Rng = Range("G" & i & ":J" & i)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[rmikesmith]

Something to keep in mind is the error you received will be generated when Rng contains fewer than k values (2 in your instance). So, if Rng consists of all empty cells then the error will be triggered.


Regards,
Mike

 

[Zathras]

The problem with the "1004" error arises when there is a non-numeric entry in one of your source cells (cols "G" thru "J" in all rows of the used range beginning on row 2.

Working with the used range can find more rows than you expect. Typically the problem arises when there are formatted cells below your "real" data area.

Here is a routine that provides the results you want, but puts #NUM! in column "P" when the values in "G" thru "J" are such that you would get the "1004" error with your routine:

Sub test2()
Dim sCurrentSelection As String
Dim nLastRow As Long
[COLOR=green]
  ' Remember current selection[/color]
  sCurrentSelection = Selection.Address
[COLOR=green]  
  ' Find last row[/color]
  nLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
[COLOR=green]  
  ' Fill column "P" with second highest values from "G" thru "J"[/color]
  With Range("P2:P" & nLastRow)
    .FormulaR1C1 = "=LARGE(RC[-9]:RC[-6],2)"
    .Select
    .Copy
    .PasteSpecial xlPasteValues
  End With
  Application.CutCopyMode = xlFalse
[COLOR=green]  
  ' Restore current selection[/color]
  Range(sCurrentSelection).Select
End Sub

 

[Excelerate2004]

PHV I just tried your suggestion, but I'm still getting that error. Like I said it executes the code and places the correct values in the spreadsheet but that error still pops up.

On to the next suggestion...

 

[Excelerate2004]

Zathras,

I tried your suggestion and that seems to have worked. What its also done is reveal that it puts the #NUM! all the way down to row 28,727 even tho there is no visble data down that far.

This tells me obviously theres some formatting "behind the scenes" that I need to get rid of.

This function: FormulaR1C1 has also resurfaced as both yourself and PHV endorsed the use of it in a previous post of mine. So I will have to go and research its function & usage.

Thanks to all who helped on this one!

 

[Excelerate2004]

Is there a way to clear out the formatted cells beneath my "real" data area.

Ive tried clearing contents, deleting all the columns, is there anything ele I can do uisng VBA?

 

[Zathras]

Delete the rows from just below your data down to row 28727 then save, close and re-open the worksheet.

If that doesn't do it, open a new worksheet and copy just the rows you want from the old.

 

[Excelerate2004]

After some quick researching I found this code to delete unused cells:

Sub DeleteUnused()
  

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub