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

[ipbr21054]

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

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 MAX]

Hello Ipbr21054,
if you still not resolved this problem,
here is code that may be helpful.

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]

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]

What do you think about search parameter length reducing.

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

 

[ipbr21054]

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]

Do you mean to use UserForm with TextBox text as search parameter input?

 

[ipbr21054]

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

Code now in use also

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

 

[EXCEL MAX]

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]

Ok
I think that will be the way forward

 

[EXCEL MAX]

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...

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...

Also use this code in the CommandButton1.

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