Edit existing working code to search for specific value & load listbox

[ipbr21054]

Hi,
The code shown is what i normally use where the user would type a value & the code would search & the load listbox with values.
Please can you edit the code for a known value to be searched without the need to type a value to search.

The value to search will allways be HONDA

  Dim r As Range, f As Range, Cell As String, added As Boolean
  Dim sh As Worksheet
 
  Set sh = Sheets("MCLIST")
  sh.Select
  With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "170;220;130"
    If MakerSearch.Value = "" Then Exit Sub
    Set r = Range("C8", Range("C" & Rows.Count).End(xlUp))
    Set f = r.Find(MakerSearch.Value, LookIn:=xlValues, LookAt:=xlPart)
    If Not f Is Nothing Then
      Cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
              .List(i, 1) = f.Offset(, -1).Value
              .List(i, 2) = f.Offset(, -2).Value
              .List(i, 3) = f.Row
              added = True
              Exit For
          End Select
        Next
        If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Offset(, -1).Value
          .List(.ListCount - 1, 2) = f.Offset(, -2).Value
          .List(.ListCount - 1, 3) = f.Row
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> Cell
      MakerSearch = UCase(MakerSearch)
      .TopIndex = 0
      Else
      MsgBox "NO MAKER WAS FOUND USING THAT INFORMATION", vbCritical, "HONDA MOTORCYCLE MAKER SEARCH"
      MakerSearch.Value = ""
      MakerSearch.SetFocus
    End If
  End With

 

[DanteAmor]

Change this line:

Set f = r.Find(MakerSearch.Value, LookIn:=xlValues, LookAt:=xlPart)

For this:

Set f = r.Find("HONDA", , xlValues, xlPart, , , False)

And delete this line:

If MakerSearch.Value = "" Then Exit Sub

complete:
Private Sub CommandButton1_Click()
Dim r As Range, f As Range, Cell As String, added As Boolean
Dim sh As Worksheet
Dim i As Long

Set sh = Sheets("MCLIST")
sh.Select
With ListBox1
.Clear
.ColumnCount = 3
.ColumnWidths = "170;220;130"
'If MakerSearch.Value = "" Then Exit Sub
Set r = Range("C8", Range("C" & Rows.Count).End(xlUp))
Set f = r.Find("HONDA", , xlValues, xlPart, , , False)
If Not f Is Nothing Then
Cell = f.Address
Do
added = False
For i = 0 To .ListCount - 1
Select Case StrComp(.List(i), f.Value, vbTextCompare)
Case 0, 1
.AddItem f.Value, i
.List(i, 1) = f.Offset(, -1).Value
.List(i, 2) = f.Offset(, -2).Value
.List(i, 3) = f.Row
added = True
Exit For
End Select
Next
If added = False Then
.AddItem f.Value
.List(.ListCount - 1, 1) = f.Offset(, -1).Value
.List(.ListCount - 1, 2) = f.Offset(, -2).Value
.List(.ListCount - 1, 3) = f.Row
End If
Set f = r.FindNext(f)
Loop While f.Address <> Cell
'MakerSearch = UCase(MakerSearch)
.TopIndex = 0
Else
MsgBox "NO MAKER WAS FOUND USING THAT INFORMATION", vbCritical, "HONDA MOTORCYCLE MAKER SEARCH"
'MakerSearch.Value = ""
'MakerSearch.SetFocus
End If
End With
End Sub

 

[DanteAmor]

Code complete:

Private Sub CommandButton1_Click()
  Dim r As Range, f As Range, Cell As String, added As Boolean
  Dim sh As Worksheet
  Dim i As Long
 
  Set sh = Sheets("MCLIST")
  sh.Select
  With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "170;220;130"
    'If MakerSearch.Value = "" Then Exit Sub
    Set r = Range("C8", Range("C" & Rows.Count).End(xlUp))
    Set f = r.Find("HONDA", , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      Cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
              .List(i, 1) = f.Offset(, -1).Value
              .List(i, 2) = f.Offset(, -2).Value
              .List(i, 3) = f.Row
              added = True
              Exit For
          End Select
        Next
        If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Offset(, -1).Value
          .List(.ListCount - 1, 2) = f.Offset(, -2).Value
          .List(.ListCount - 1, 3) = f.Row
        End If
        Set f = r.FindNext(f)
      Loop While f.Address <> Cell
      'MakerSearch = UCase(MakerSearch)
      .TopIndex = 0
    Else
      MsgBox "NO MAKER WAS FOUND USING THAT INFORMATION", vbCritical, "HONDA MOTORCYCLE MAKER SEARCH"
      'MakerSearch.Value = ""
      'MakerSearch.SetFocus
    End If
  End With
End Sub