vba - find max values

[Ben_UK]

Hiya Board

vba newbie again!

In Column A I have a random range of numerical data (5000 - 7000 entries)
I have the following code to highlight the row location of the max value.
--------------
Sub FindMax()

MaxVal = Application.WorksheetFunction. _
Max(Range("A:A"))
For Row = 1 To 65536
If Range("A1").Offset(Row - 1, 0).Value = MaxVal Then
Range("A1").Offset(Row - 1, 0).Activate
MsgBox "The max value can be found in row " & Row
Exit For
End If
Next Row

End Sub

------------

Occasionally up to 5 rows may contain the max figure,
How do I highlight all those row locations?

Once again, Any help would be greatly appreciated

Kind Regards

Ben.

 

[Tom Urtis]

Not sure if you want only the cell(s) containing the maximum value highlighted, or the entire row. The macro below highlights just the cell, but can be easily modified by an .EntireRow script. Modify for desired color; this example is for yellow.

Sub ShadeMax()
Application.ScreenUpdating = False
Dim MaxValRange, MaxVal
Set MaxValRange = Range("A:A")
MaxVal = Application.WorksheetFunction.Max(MaxValRange)
MaxValRange.Interior.ColorIndex = 0
With MaxValRange
Dim C, BegAdd
Set C = .Find(MaxVal, LookIn:=xlValues)
If Not C Is Nothing Then
BegAdd = C.Address
Do
C.Interior.ColorIndex = 6
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> BegAdd
End If
End With
Application.ScreenUpdating = True
End Sub

 

[Ben_UK]

max values

Hiya Tom,

Many apologies for not responding quickly,

Your code fits my requirements perfectly,

Thanks for your time and effort

Kind Regards

Ben

 

[Nykyta]

Sub ShadeMax()
Application.ScreenUpdating = False
Dim MaxValRange, MaxVal
Set MaxValRange = Range("A:A")
MaxVal = Application.WorksheetFunction.Max(MaxValRange)
MaxValRange.Interior.ColorIndex = 0
With MaxValRange
Dim C, BegAdd
Set C = .Find(MaxVal, LookIn:=xlValues)
If Not C Is Nothing Then
BegAdd = C.Address
Do
C.Interior.ColorIndex = 6
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> BegAdd
End If
End With
Application.ScreenUpdating = True
End Sub

Why you didn't end your macro after the line:
If Not C Is Nothing Then
?

Why you continued with 'BegAdd = C.Address ..." etc?
If Not C Is Nothing Then
C.interior.color = 'something'
exit sub
end if

I simple wonder...