Let say we want to find position of cell containing the minimum/maximum value in current/active Excel worksheet, and then after we found the cell, we will change the cell format to make it stand out before other cells.
The logic is simple, we just need to use Excel MIN function to find the minimum/maximum value on the worksheet, and then using Excel FIND function we will find which cell contain that minimum/ maximum value.
Excel VBA macro implementation of the algorithm above will look like below, change code Application.Min(oRg) into Application.Max(oRg) to find the maximum value instead of minimum value.
Sub FindMinValue()
Dim oRg As Range, iMin As Variant
Set oRg = Cells
'Finding the minimum value
'change Application.Min(oRg) into Application.Max(oRg) to find the maximum value
iMin = Application.Min(oRg)
'Select cell containing the min value
oRg.Find(What:=iMin, _
After:=oRg.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False _
).Select
'Change selected cell format
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Displaying min value info
With Selection
MsgBox "Min value : " & iMin & vbCrLf & _
"Cell position " & vbCrLf & _
"Row : " & .Row & vbCrLf & _
"Column : " & .Column
End With
End Sub
The logic is simple, we just need to use Excel MIN function to find the minimum/maximum value on the worksheet, and then using Excel FIND function we will find which cell contain that minimum/ maximum value.
Excel VBA macro implementation of the algorithm above will look like below, change code Application.Min(oRg) into Application.Max(oRg) to find the maximum value instead of minimum value.
Sub FindMinValue()
Dim oRg As Range, iMin As Variant
Set oRg = Cells
'Finding the minimum value
'change Application.Min(oRg) into Application.Max(oRg) to find the maximum value
iMin = Application.Min(oRg)
'Select cell containing the min value
oRg.Find(What:=iMin, _
After:=oRg.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False _
).Select
'Change selected cell format
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Displaying min value info
With Selection
MsgBox "Min value : " & iMin & vbCrLf & _
"Cell position " & vbCrLf & _
"Row : " & .Row & vbCrLf & _
"Column : " & .Column
End With
End Sub
No comments:
Post a Comment