Search: | |||||

| ||||

Home » Forum » MS Office | RSS Feeds |

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.

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

task.

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.

Related Topics:

- Find a match in a range and copy contents to templates workbook
- 20 Mins Process in Application Server
- "Min 4" function?
- How to get MIN, MAX and AVG of a variable sized table
- using find find all
- Problems with XL's 'MATCH' function
- Sorting and Matching
- Cell search & match and grab and compare from another column
- Matching and sorting 2 excel files
- pasting word table to Excel but needing to match excel
- 2003 Match() Problem
- matching data from 2 worksheets
- Match game
- java pattern matching
- Looping thru values to match w/ other values
- Matching date values w/ dropdown values
- Formula to match,lookup and then retun alternate value
- loop thorugh a column and copy to matching workbook
- How to resolve error 13 - type miss match
- How to make WorksheetFunction.MATCH OR .VLOOKUP work?
- how to create an al program that matches several entries using weight
- kundali/Horoscope matching for marriage
- Need help in finding duplicates
- code to find substring in main string
- find deviders