Look for closest value in column from value in input field or TextBox

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,043
Office Version
  1. 2007
Platform
  1. Windows
Hi.

I am open to suggestion but i have this below at present to get me started.

I click on my command button & enter a value in the input field.
Example of input field value would be SHHCH1590XU201591
Now the code should look in column A4:A & advise me of the first nearest match.
Either MsgBox Your Nearest matc is at Row 55

Chances of the exact value being there is slim BUT possible hence nearest match.

If it is easier for you there is TextBox 1 on the worksheet & also a command button.
So maybe enter value in TextBox1 press command button & nearest match would turn that cell in column A red ??

I have the code so far in place but get a RTE 2004 each time so now stuck

Rich (BB code):
Private Sub CommandButton1_Click()
   Dim ans As String
   Dim Fnd As Range
   Do Until Not Fnd Is Nothing
      ans = InputBox("Enter search for value")
      If ans = "" Then Exit Sub
      Set Fnd = Range("A4:A").Find(ans, , , xlPart, , , False, , False)
   Loop
End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
418
Office Version
  1. 2016
Platform
  1. Windows
Hello Ipbr21054,
if you still not resolved this problem,
here is code that may be helpful.

VBA Code:
Private Sub CommandButton1_Click()
    
    Dim ans As String
    Dim Fnd As Range
    Dim varNRows As Long
    Dim varFndRow As Long
    
    varNRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A4:" & "A" & varNRows).Interior.Color = xlNone
    ans = InputBox("Enter search for value")
    If ans = "" Then Exit Sub
    Set Fnd = Range("A4:A" & varNRows).Find _
        (ans, Range("A" & varNRows), , xlPart, , , False, , False)
    If Not Fnd Is Nothing Then
        varFndRow = Fnd.Row
        Cells(varFndRow, "A").Interior.Color = RGB(255, 0, 0)
        MsgBox "Your Nearest matc is at Row " & varFndRow
    End If

End Sub
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,043
Office Version
  1. 2007
Platform
  1. Windows
Thanks for that.
I have it in use and looking good.

One thing ive noticed.

If i have the value SHHFK174???? It then turns the cell RED & i see the Msgbox lets say it mentions Found At Row 122

BUT if i was to have the value that starts say SHHFK173?????? im not told that Row 122 is the nearest match.
There were no others that started SHHFK173 not sure if that helps in any way

Did another test for you.

Value is SHHFK & i am told the first of the SHHFK values no problem.
Lets assume the first value is SHHFK2 BUT i enter the value of SHHFK1 nothing is advised,
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
418
Office Version
  1. 2016
Platform
  1. Windows
What do you think about search parameter length reducing.

VBA Code:
Private Sub CommandButton1_Click()
    
    Dim ans As String
    Dim Fnd As Range
    Dim varNRows As Long
    Dim varFndRow As Long

    varNRows = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range("A4:" & "A" & varNRows).Interior.Color = xlNone
    ans = InputBox("Enter search for value")
    If ans = "" Then Exit Sub
EX:    
    Set Fnd = Range("A4:A" & varNRows).Find _
        (ans, Range("A" & varNRows), , xlPart, , , False, , False)
    If Not Fnd Is Nothing Then
        varFndRow = Fnd.Row
        Cells(varFndRow, "A").Interior.Color = RGB(255, 0, 0)
        MsgBox "Your Nearest matc is at Row " & varFndRow
    Else
        ans = Left(ans, Len(ans) - 1)
        GoTo EX
    End If

End Sub
 
Solution

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,043
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Thanks thats better.

I have been looking for a way to style the INPUTBOX but all i seem to find is MsgBox styling.
Can you advise please or point me in the right direction.
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
418
Office Version
  1. 2016
Platform
  1. Windows
Do you mean to use UserForm with TextBox text as search parameter input?
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,043
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

This inputbox that appears when i click my command button.
See image attached & also read text in input field

Code now in use also

Rich (BB code):
Private Sub CommandButton1_Click()
    
    Dim ans As String
    Dim Fnd As Range
    Dim varNRows As Long
    Dim varFndRow As Long

    varNRows = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range("A4:" & "A" & varNRows).Interior.Color = vbGreen
    ans = InputBox("ENTER A PARTIAL VIN TO BEGIN THE SEARCH")
    If ans = "" Then Exit Sub
EX:
    Set Fnd = Range("A4:A" & varNRows).Find _
        (ans, Range("A" & varNRows), , xlPart, , , False, , False)
    If Not Fnd Is Nothing Then
        varFndRow = Fnd.Row
        Cells(varFndRow, "A").Interior.Color = RGB(51, 255, 255)
        MsgBox "THE NEAREST MATCH IS AT ROW " & varFndRow, vbInformation
        Cells(varFndRow, "A").Select
    Else
        ans = Left(ans, Len(ans) - 1)
        GoTo EX
    End If

End Sub
 

Attachments

  • 1309.jpg
    1309.jpg
    51.9 KB · Views: 4

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
418
Office Version
  1. 2016
Platform
  1. Windows
Sorry, it's out of my scope,
but if you ready to use UserForm with TextBox instead InputBox I'm ready to help you.
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
4,043
Office Version
  1. 2007
Platform
  1. Windows
Ok
I think that will be the way forward
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
418
Office Version
  1. 2016
Platform
  1. Windows
Create new UserForm that will look as InputBox, with one TextBox, two buttons and Label.
Rename userform to "frmInputBox", TextBox to "txtInput", CommandButton1 to "btnOK", CommandButton2 to "btnCancel"
and Label1 to lblInputBox.
Insert this code to frmInputBox code module...

VBA Code:
Private Sub UserForm_Initialize()
   
    txtInput.TextAlign = fmTextAlignCenter
    txtInput.SetFocus
    txtInput.Text = ""
    lblInputBox.Caption = "ENTER A PARTIAL VIN TO BEGIN THE SEARCH"
    Caption = "Microsoft Excel"
   
End Sub

Private Sub txtInput_Change()
   
    txtInput.Text = UCase(txtInput.Text)
   
End Sub

Private Sub btnCancel_Click()
   
    txtInput.Text = ""
    Hide
   
End Sub

Private Sub btnOK_Click()
   
    Hide
   
End Sub

It should look something like this...

InputBox.PNG


Also use this code in the CommandButton1.

VBA Code:
Private Sub CommandButton1_Click()
   
    Dim ans As String
    Dim Fnd As Range
    Dim varNRows As Long
    Dim varFndRow As Long

    varNRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A4:" & "A" & varNRows).Interior.Color = vbGreen
    frmInputBox.Show
    ans = frmInputBox.txtInput.Text
    frmInputBox.txtInput.Text = ""
    frmInputBox.txtInput.SetFocus
    If ans = "" Then Exit Sub
EX:
    Set Fnd = Range("A4:A" & varNRows).Find _
        (ans, Range("A" & varNRows), , xlPart, , , False, , False)
    If Not Fnd Is Nothing Then
        varFndRow = Fnd.Row
        Cells(varFndRow, "A").Interior.Color = RGB(51, 255, 255)
        MsgBox "THE NEAREST MATCH IS AT ROW " & varFndRow, vbInformation
        Cells(varFndRow, "A").Select
    Else
        ans = Left(ans, Len(ans) - 1)
        GoTo EX
    End If

End Sub
 
Last edited:

Forum statistics

Threads
1,136,788
Messages
5,677,738
Members
419,716
Latest member
MPunt

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top