 Search:

# find min and match

Asked By: Muaz    Date: Jan 26    Category: MS Office    Views: 1678

i have a column a to L and around 600 values in each column.
i want to find the maximum value in column L, ex. max value is -160.
then i want the half of max i.e -80, and look in column L that is
close to -80 select that value and macth the corresponding value in A
and return the same in m.

would be really pleased if some could help me in coding with VBA.

Share:

If I understand your request correctly, you don't need VBA to accomplish the

1. Insert a new column  to the left of column A. If the data in column M (used
to be column L) begins in row 5, then in A5 enter this formula: =M5 . Copy
this formula down in column A for as many rows as there is data in column M.

2. In N5, enter this formula: =VLOOKUP(ROUND(MAX(M:M)/2,0),A:B,2,FALSE)

- You may not need or want to round MAX(M:M)/2

- I'm not clear whether you want the maximum value or the minimum value. The
formula above is for the maximum value; just replace MAX with min  to get the
minimum value.

- The above approach works if column M always includes the maximum value AND a
value which is half that amount. If you want the closest value to MAX(M:M)/2
when there is no exact match  you have to do a couple things:

A. Step 1 as above, but then sort the data in ascending order by the new
column A.

B. In the formula in step 2 above, replace FALSE with TRUE.

but the formula is not working when it is looking for a
value which is not actually in the table. and it is not returning me the correct
value.

-If you want the closest value to MAX(M:M)/2 when there is no exact match  you
have to do a couple things:

A. Step 1 as above, but then sort the data in ascending order by the new
column A.

B. In the formula in step 2 above, replace FALSE with TRUE.

That's an additional requirement you didn't mention before. Try this modified
code:

Sub AAAA()
ActiveSheet.Range("M5").Value = FindValue("L", "A", 5)
End Sub

Public Function FindValue(ColToSearch As String, ColToReturn As String,
FirstRow As Long) As Double
'Finds the smallest value in ColToSearch. Then searches ColToSearch for the
value which is
'closest to half that value and has an index (ColToReturn value) which is
greater than the index for
'the min  value. When the closest value in ColToSearch has been identified,
returns the value in
'ColToReturn from that row.
Dim msg1 As String, MinVal As Double, MinIndex As Double, HalfMin As Double,
Rng As Range
Dim ClosestVal As Double, ClosestRow As Long, Diff As Double, LastRow As
Long
On Error GoTo FVerr1
'Find the last row with data in ColToSearch.
LastRow& = FindLastRow(ColToSearch\$)
'Set the Rng object variable to the data range in ColToSearch. Must use a Range
object variable when
'using the Min function from VBA.
Set Rng = ActiveSheet.Range(ColToSearch\$ & FirstRow & ":" & ColToSearch\$ &
LastRow&)
'Find the smallest value. Store its index. Divide smallest value by 2 and store
as MinVal#.
MinVal# = Application.WorksheetFunction.Min(Rng)
MinIndex# = Range(ColToReturn\$ &
CLng(Application.WorksheetFunction.Match(MinVal#, Rng, 0) + FirstRow& -
1)).Value
HalfMin# = MinVal# / 2
ClosestVal# = 0
'Walk down through the cells in ColToSearch and find  the closest value to
HalfMin#.
Application.ScreenUpdating = False
Range(ColToSearch\$ & FirstRow).Activate
Do While ActiveCell.Row <= LastRow&
'Only interested in this cell if its index (ColToReturn value) is greater than
MinIndex#.
If Range(ColToReturn\$ & ActiveCell.Row).Value > MinIndex# Then
'Measure how far this cell's value is from HalfMin#
Diff# = Abs(ActiveCell.Value - HalfMin#)
'If this cell's value is closer to HalfMin# than the current ClosestVal#, make
this cell
'the new ClosestVal and store its row number.
If (Diff# < Abs(HalfMin# - ClosestVal#)) Then
ClosestVal# = ActiveCell.Value
ClosestRow& = ActiveCell.Row
End If
End If
ActiveCell.Offset(1, 0).Activate
Loop
'Return the value in ColToReturn from ClosestRow&.
FindValue# = Range(ColToReturn\$ & ClosestRow&).Value
Cleanup1:
Application.ScreenUpdating = True
Set Rng = Nothing
Exit Function
FVerr1:
If Err.Number <> 0 Then
msg1\$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg1\$, , "FindValue error", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Function

Public Function FindLastRow(WhichCol As String) As Long
'Returns the last row in a column  with something in it. Returns zero if the
'entire Column Is Empty
Dim LastRow As Long
LastRow& = 65536
If IsEmpty(Cells(LastRow&, WhichCol\$)) Then
LastRow& = Cells(LastRow, WhichCol\$).End(xlUp).Row
If LastRow& = 1 And IsEmpty(Cells(LastRow&, WhichCol\$)) Then LastRow& =
0
End If
FindLastRow& = LastRow&
End Function

Didn't find what you were looking for? Find more on find min and match Or get search suggestion and latest updates.