Find and select maximum value in a range

[Mcneilius]

Hi all

I'm trying to get a macro to find and select cell that contains th
maximum value of 3 selected cells.

Say cells A1 to A3 contain 2.45, 3.36, 2.78 (these numbers can change)
the macro currently looks like:

Sub FindMax()

Range("A1").Activate
StartCell = ActiveCell.Offset(0, 0).Address
EndCell = ActiveCell.Offset(0, 2).Address
Range(StartCell, EndCell).Select

Dim WorkRange As Range

Set WorkRange = Selection

MaxVal = Application.Max(WorkRange)

On Error Resume Next
Workrange.Find(What:=MaxVal, _
After:=Workrange.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False _
).Select
If Err <> 0 Then MsgBox "Max value was not found: " & MaxVal

End Sub

The code seems to work well on some selections, and not on others.
Sometimes there is a unique maximum of, say, 3.36 and it will say "Ma
Value was not found: 3.36" !?!?

Please, does anyone have any ideas on where I'm going wrong?

Thanks for your time

Nei

 

[Dave Peterson]

This portion:

Range("A1").Activate
StartCell = ActiveCell.Offset(0, 0).Address
EndCell = ActiveCell.Offset(0, 2).Address
Range(StartCell, EndCell).Select

is really pointing at A1:C1 (not A1:A3)

..offset(0,2) is 2 columns to the right.

And you may want to use xlwhole instead of xlpart, too.

====
And you may want to try it without selecting ranges:

Option Explicit
Sub FindMax()
Dim StartCell As Range
Dim EndCell As Range
Dim WorkRange As Range
Dim MaxVal As Double
Dim FoundCell As Range

Set StartCell = Range("a1").Offset(0, 0)
Set EndCell = Range("a1").Offset(0, 2)

Set WorkRange = Range(StartCell, EndCell)

MaxVal = Application.Max(WorkRange)

Set FoundCell = WorkRange.Find(What:=MaxVal, _
After:=WorkRange.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
MsgBox "Max value was not found: " & MaxVal
Else
MsgBox "Found it at: " & _
FoundCell.Address(0, 0) & " = " & FoundCell.Value
End If

End Sub

(

 

[Mcneilius]

Thanks for the reply Dave

I used your code exactly and it does work on some lines, though not on
others.

For example, running your code on each line (Used a Do While... Loop)
in the following set of cells works on the first line, but not on the
others.

Any ideas why this might be? I can't see that it's due to how the
figures fall either side of zero or anything like that. Could it be
getting confused by rounding of the figures or something?

Again, it seems to pick the maximum value ok, but it doesn't find it.

Thanks again for your help!

=======

A B C

-38.650 -33.271 11.875
-76.710 -40.285 120.690
-47.500 9.551 114.765
-3.226 -10.959 -17.568
-34.247 6.538 106.463
-22.414 -18.224 -3.120
3.571 -27.769 -32.302
-34.884 -8.219 4.054
44.828 -41.176 -59.335
20.192 -25.450 -44.255

 

[Dave Peterson]

I used a for/next loop to go through a bunch of cells.

I wrote the value to column D of that same row (nice for checking):

Option Explicit
Sub FindMax2()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim MaxVal As Double
Dim FoundCell As Range
Dim WorkRange As Range
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
Set WorkRange = .Cells(iRow, "A").Resize(1, 3)
MaxVal = Application.Max(WorkRange)

With WorkRange
Set FoundCell = .Cells.Find(What:=MaxVal, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If FoundCell Is Nothing Then
MsgBox "Max value was not found: " & MaxVal
Else
'MsgBox "Found it at: " & _
FoundCell.Address(0, 0) & " = " & FoundCell.Value
WorkRange.Resize(1, 1).Offset(0, 3).Value = FoundCell.Value
End If
Next iRow

End With

End Sub