Match numbers in a colunm

[Peterfc2]

Look for all matches in a sorted list. If no exact match is found all the nearest matches.
Been looking at lot of examples none I can adapt. Cheers Peter
e.g.
Col A/Col B
Tom 10
Bob 20
Mob 30
Yan 40
Den 40
Elf 50
Len 50
If my target is 40 I should have Ian 40 and den 40 should be listed.
If no exact match all nearest should be listed even if higher or lower. If target 45.
Yan 40
Den 40
Elf 50
Len 50
Good luck!

 

[DanteAmor]

Put the target in cell D45 and execute the macro Match_numbers

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >NAME</td><td >VALUE</td><td > </td><td style="text-align:right; ">45</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Tom</td><td style="text-align:right; ">10</td><td > </td><td >Yan</td><td style="text-align:right; ">40</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Bob</td><td style="text-align:right; ">20</td><td > </td><td >Den</td><td style="text-align:right; ">40</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Mob</td><td style="text-align:right; ">30</td><td > </td><td >Elf</td><td style="text-align:right; ">50</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Yan</td><td style="text-align:right; ">40</td><td > </td><td >Len</td><td style="text-align:right; ">50</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Den</td><td style="text-align:right; ">40</td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Elf</td><td style="text-align:right; ">50</td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="color:#333333; font-family:Verdana; font-size:9pt; ">Len</td><td style="text-align:right; ">50</td><td > </td><td > </td><td > </td></tr></table>

Sub Match_numbers()
    Dim v As String, f As Range, r As Range, cell As String
    
    Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
    v = Range("D1").Value
    Range("D2:D" & Rows.Count).ClearContents
    
    Set f = r.Find(v, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        Call match_loop(r, f)
    Else
        d = Evaluate("=MIN(ABS(" & r.Address & "-" & v & "))")
        v = v - d
        Set f = r.Find(v, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            Call match_loop(r, f)
        End If
        v = v + d + d
        Set f = r.Find(v, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            Call match_loop(r, f)
        End If
    End If
End Sub
Sub match_loop(r, f)
        cell = f.Address
        Do
            Range("D" & Rows.Count).End(xlUp)(2).Resize(1, 2).Value = f.Offset(0, -1).Resize(1, 2).Value
            Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> cell
End Sub

 

[Peterfc2]

Put the target in cell D45 and execute the macro Match_numbers. Entered my target number in D1. Works perfectly. Brilliant and so quick with the solution.

 

[Peterfc2]

Just to tidy one bit up I added a line to clear Column E too. Again Brilliant.

 

[DanteAmor]

Just to tidy one bit up I added a line to clear Column E too. Again Brilliant.

update with this

[COLOR=#333333]Range("D2:[/COLOR][COLOR=#ff0000]E[/COLOR][COLOR=#333333]" & Rows.Count).ClearContents[/COLOR]