I'm working on a Excel VBA search box. How can I put a message box when records not found on the list?
Private Sub CommandButton2_Click()
Me.TextBox1.Value = UCase(Me.TextBox1.Value)
Dim sh As Worksheet
Set sh = Sheets("Sheet1")
Dim i As Long
Dim x As Long
Dim P As Long
Me.ListBox1.Clear
For i = 2 To sh.Range("F" & Rows.Count).End(xlUp).Row
For x = 1 To Len(sh.Cells(i, 6))
P = Me.TextBox1.TextLength
If LCase(Mid(sh.Cells(i, 6), x, P)) = Me.TextBox1 And Me.TextBox1 <> "" Then
With Me.ListBox1
.AddItem sh.Cells(i, 1)
.List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 2)
.List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 3)
.List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 4)
.List(ListBox1.ListCount - 1, 4) = sh.Cells(i, 5)
.List(ListBox1.ListCount - 1, 5) = sh.Cells(i, 6)
.List(ListBox1.ListCount - 1, 6) = sh.Cells(i, 7)
.List(ListBox1.ListCount - 1, 7) = sh.Cells(i, 8)
End With
End If
Next x
Next i
r = Sheet1.Columns("A").ColumnWidth * 7
ListBox1.ColumnWidths = "70;60;80;230;230;100;60;" & r & ";"
End Sub
Do like this.
Private Sub CommandButton2_Click()
Me.TextBox1.Value = UCase(Me.TextBox1.Value)
Dim sh As Worksheet
Set sh = Sheets("Sheet1")
Dim i As Long
Dim x As Long
Dim P As Long
Dim n As Long
Me.ListBox1.Clear
For i = 2 To sh.Range("F" & Rows.Count).End(xlUp).Row
For x = 1 To Len(sh.Cells(i, 6))
P = Me.TextBox1.TextLength
If LCase(Mid(sh.Cells(i, 6), x, P)) = Me.TextBox1 And Me.TextBox1 <> "" Then
n = n + 1 '<~~ count items
With Me.ListBox1
.AddItem sh.Cells(i, 1)
.List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 2)
.List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 3)
.List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 4)
.List(ListBox1.ListCount - 1, 4) = sh.Cells(i, 5)
.List(ListBox1.ListCount - 1, 5) = sh.Cells(i, 6)
.List(ListBox1.ListCount - 1, 6) = sh.Cells(i, 7)
.List(ListBox1.ListCount - 1, 7) = sh.Cells(i, 8)
End With
End If
Next x
Next i
If n Then
MsgBox n & " Items were selected", vbInformation
Else
MsgBox "value not found", vbInformation
End If
r = Sheet1.Columns("A").ColumnWidth * 7
ListBox1.ColumnWidths = "70;60;80;230;230;100;60;" & r & ";"
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.