UserForm filter Search Runtime Issue

P

pure vito

Board Regular
Joined
Oct 7, 2021
Messages
180
Office Version
  1. 365
Platform
  1. Windows
Hi All,

Firstly please forgive the way I have structured this I'm still very much a novice when it comes to VBA,

The first code is copied into the VBA sheet (people) when I type a name into B4 it will automatically filter the Name in column (C) this works fine,

Moving into my userform I have a search bar (Textbox1) the second code is my user form code it transfers the text from (Textbox1) to the sheet (people B4) triggering the filter,

The issue I am having is that if the wrong name or an unknown name is typed in and can not be found in the column it gives me a run time error, meaning the user has the end and restart,

Can anyone help with this issue please, again I'm very sorry but i can't get the L2BB to work for me so I have included a copy of the document if required, Thanks in advance.

Launch Holiday Tracker 2023.xlsm

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
  If Target.Address = "$B$4" Then
    If ActiveSheet.FilterMode Then ShowAllData
    If Len(Target.Value) > 0 Then Range("C1").CurrentRegion.AutoFilter Field:=1, Criteria1:="*" & Target.Value & "*"
    Application.ScreenUpdating = True
  End If
End Sub


VBA Code: 
Private Sub resetadd_Click()
  
Application.ScreenUpdating = False
Sheets("Home").Select
    Sheets("People").Visible = True
    Sheets("People").Select
Sheets("People").Range("B4") = TextBox1.Value

    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("C999").Select
    'ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
startdate.Value = Sheets("People").Range("E1000").Value
service.Value = Sheets("People").Range("G1000").Value
undays.Value = Sheets("People").Range("H1000").Value
lieu.Value = Sheets("People").Range("K1000").Value
earned.Value = Sheets("People").Range("J1000").Value
floating.Value = Sheets("People").Range("I1000").Value
area.Value = Sheets("People").Range("L1000").Value
pass.Value = Sheets("People").Range("M1000").Value
ID.Value = Sheets("People").Range("C1000").Value
orical.Value = Sheets("People").Range("D1000").Value
myhr.Value = Sheets("People").Range("F1000").Value
contact.Value = Sheets("People").Range("N1000").Value
email.Value = Sheets("People").Range("O1000").Value
p60.Value = Sheets("People").Range("Q1000").Value
p60c.Value = Sheets("People").Range("S1000").Value
p60z.Value = Sheets("People").Range("U1000").Value
longforks.Value = Sheets("People").Range("W1000").Value
counter.Value = Sheets("People").Range("Y1000").Value
reach.Value = Sheets("People").Range("AA1000").Value
flatbed.Value = Sheets("People").Range("AC1000").Value
bframe.Value = Sheets("People").Range("AE1000").Value
cframe.Value = Sheets("People").Range("AG1000").Value
eframe.Value = Sheets("People").Range("AI1000").Value
phev.Value = Sheets("People").Range("AK1000").Value
manual.Value = Sheets("People").Range("AM1000").Value

If Worksheets("People").Range("P1000").Text = "yes" Then
p60v.Value = True
Else
p60v.Value = False
End If
    If Worksheets("People").Range("R1000").Text = "yes" Then
p60cv.Value = True
Else
p60cv.Value = False
End If
    If Worksheets("People").Range("T1000").Text = "yes" Then
p60zv.Value = True
Else
p60zv.Value = False
End If
    If Worksheets("People").Range("V1000").Text = "yes" Then
longforksv.Value = True
Else
longforksv.Value = False
End If
    If Worksheets("People").Range("X1000").Text = "yes" Then
counterv.Value = True
Else
counterv.Value = False
End If
    If Worksheets("People").Range("Z1000").Text = "yes" Then
reachv.Value = True
Else
reachv.Value = False
End If
If Worksheets("People").Range("AB1000").Text = "yes" Then
flatbedv.Value = True
Else
flatbedv.Value = False
End If
    If Worksheets("People").Range("AD1000").Text = "yes" Then
bframev.Value = True
Else
bframev.Value = False
End If
    If Worksheets("People").Range("AF1000").Text = "yes" Then
cframev.Value = True
Else
cframev.Value = False
End If
    If Worksheets("People").Range("AH1000").Text = "yes" Then
eframev.Value = True
Else
eframev.Value = False
End If
    If Worksheets("People").Range("AJ1000").Text = "yes" Then
phevv.Value = True
Else
phevv.Value = False
End If
    If Worksheets("People").Range("AL1000").Text = "yes" Then
manualv.Value = True
Else
manualv.Value = False
End If
Range("C800:AZ1200").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C800").Select
        ActiveSheet.Range("$C$1:$AM$989").AutoFilter Field:=1
    Range("C22").Select
    Selection.End(xlUp).Select
    Sheets("People").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Home").Select
   
    
     Application.ScreenUpdating = True

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Hi there

Try replacing with this piece of code...

VBA Code: 
Private Sub resetadd_Click()
  On Error GoTo errorhandler:
Application.ScreenUpdating = False
Sheets("Home").Select
    Sheets("People").Visible = True
    Sheets("People").Select
Sheets("People").Range("B4") = TextBox1.Value

    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("C999").Select
    'ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
startdate.Value = Sheets("People").Range("E1000").Value
service.Value = Sheets("People").Range("G1000").Value
undays.Value = Sheets("People").Range("H1000").Value
lieu.Value = Sheets("People").Range("K1000").Value
earned.Value = Sheets("People").Range("J1000").Value
floating.Value = Sheets("People").Range("I1000").Value
area.Value = Sheets("People").Range("L1000").Value
pass.Value = Sheets("People").Range("M1000").Value
ID.Value = Sheets("People").Range("C1000").Value
orical.Value = Sheets("People").Range("D1000").Value
myhr.Value = Sheets("People").Range("F1000").Value
contact.Value = Sheets("People").Range("N1000").Value
email.Value = Sheets("People").Range("O1000").Value
p60.Value = Sheets("People").Range("Q1000").Value
p60c.Value = Sheets("People").Range("S1000").Value
p60z.Value = Sheets("People").Range("U1000").Value
longforks.Value = Sheets("People").Range("W1000").Value
counter.Value = Sheets("People").Range("Y1000").Value
reach.Value = Sheets("People").Range("AA1000").Value
flatbed.Value = Sheets("People").Range("AC1000").Value
bframe.Value = Sheets("People").Range("AE1000").Value
cframe.Value = Sheets("People").Range("AG1000").Value
eframe.Value = Sheets("People").Range("AI1000").Value
phev.Value = Sheets("People").Range("AK1000").Value
manual.Value = Sheets("People").Range("AM1000").Value

If Worksheets("People").Range("P1000").Text = "yes" Then
p60v.Value = True
Else
p60v.Value = False
End If
    If Worksheets("People").Range("R1000").Text = "yes" Then
p60cv.Value = True
Else
p60cv.Value = False
End If
    If Worksheets("People").Range("T1000").Text = "yes" Then
p60zv.Value = True
Else
p60zv.Value = False
End If
    If Worksheets("People").Range("V1000").Text = "yes" Then
longforksv.Value = True
Else
longforksv.Value = False
End If
    If Worksheets("People").Range("X1000").Text = "yes" Then
counterv.Value = True
Else
counterv.Value = False
End If
    If Worksheets("People").Range("Z1000").Text = "yes" Then
reachv.Value = True
Else
reachv.Value = False
End If
If Worksheets("People").Range("AB1000").Text = "yes" Then
flatbedv.Value = True
Else
flatbedv.Value = False
End If
    If Worksheets("People").Range("AD1000").Text = "yes" Then
bframev.Value = True
Else
bframev.Value = False
End If
    If Worksheets("People").Range("AF1000").Text = "yes" Then
cframev.Value = True
Else
cframev.Value = False
End If
    If Worksheets("People").Range("AH1000").Text = "yes" Then
eframev.Value = True
Else
eframev.Value = False
End If
    If Worksheets("People").Range("AJ1000").Text = "yes" Then
phevv.Value = True
Else
phevv.Value = False
End If
    If Worksheets("People").Range("AL1000").Text = "yes" Then
manualv.Value = True
Else
manualv.Value = False
End If
Range("C800:AZ1200").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C800").Select
        ActiveSheet.Range("$C$1:$AM$989").AutoFilter Field:=1
    Range("C22").Select
    Selection.End(xlUp).Select
    Sheets("People").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Home").Select
  
   
     Application.ScreenUpdating = True
errorhandler:
Exit Sub
End Sub
 
Upvote 0
That's great thanks Jimmy, however the message box is appearing now for every search even if correct
 
Upvote 0
pure vito said:
That's great thanks Jimmy, however the message box is appearing now for every search even if correct
Click to expand...
I saw that... Just remove the messagebox part and keep it like this

VBA Code: 
errorhandler:
Exit Sub
 
Upvote 0
Hi @pure vito No problem and thanks for the feedback. Glad we could assist. :cool:

Might I suggest the slight change in code? See below:

1. I saw on clearing that your checkboxes still stayed checked. Code updated to clear these as well together with textboxes.
2. Msgbox added that will only run on error or value not found. Will not run if data exists.

Please test and let me know if it is working?

VBA Code: 
Private Sub resetadd_Click()
    Dim errMsg      As String
    On Error GoTo errHandler
    'Stage 1
    errMsg = "You have entered a value that does Not exist in the database. Please try again."
    Application.ScreenUpdating = False
    Sheets("Home").Select
    Sheets("People").Visible = True
    Sheets("People").Select
    Sheets("People").Range("B4") = TextBox1.Value
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("C999").Select
    'ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    startdate.Value = Sheets("People").Range("E1000").Value
    service.Value = Sheets("People").Range("G1000").Value
    undays.Value = Sheets("People").Range("H1000").Value
    lieu.Value = Sheets("People").Range("K1000").Value
    earned.Value = Sheets("People").Range("J1000").Value
    floating.Value = Sheets("People").Range("I1000").Value
    area.Value = Sheets("People").Range("L1000").Value
    pass.Value = Sheets("People").Range("M1000").Value
    ID.Value = Sheets("People").Range("C1000").Value
    orical.Value = Sheets("People").Range("D1000").Value
    myhr.Value = Sheets("People").Range("F1000").Value
    contact.Value = Sheets("People").Range("N1000").Value
    email.Value = Sheets("People").Range("O1000").Value
    p60.Value = Sheets("People").Range("Q1000").Value
    p60c.Value = Sheets("People").Range("S1000").Value
    p60z.Value = Sheets("People").Range("U1000").Value
    longforks.Value = Sheets("People").Range("W1000").Value
    counter.Value = Sheets("People").Range("Y1000").Value
    reach.Value = Sheets("People").Range("AA1000").Value
    flatbed.Value = Sheets("People").Range("AC1000").Value
    bframe.Value = Sheets("People").Range("AE1000").Value
    cframe.Value = Sheets("People").Range("AG1000").Value
    eframe.Value = Sheets("People").Range("AI1000").Value
    phev.Value = Sheets("People").Range("AK1000").Value
    manual.Value = Sheets("People").Range("AM1000").Value
    If Worksheets("People").Range("P1000").Text = "yes" Then
        p60v.Value = True
    Else
        p60v.Value = False
    End If
    If Worksheets("People").Range("R1000").Text = "yes" Then
        p60cv.Value = True
    Else
        p60cv.Value = False
    End If
    If Worksheets("People").Range("T1000").Text = "yes" Then
        p60zv.Value = True
    Else
        p60zv.Value = False
    End If
    If Worksheets("People").Range("V1000").Text = "yes" Then
        longforksv.Value = True
    Else
        longforksv.Value = False
    End If
    If Worksheets("People").Range("X1000").Text = "yes" Then
        counterv.Value = True
    Else
        counterv.Value = False
    End If
    If Worksheets("People").Range("Z1000").Text = "yes" Then
        reachv.Value = True
    Else
        reachv.Value = False
    End If
    If Worksheets("People").Range("AB1000").Text = "yes" Then
        flatbedv.Value = True
    Else
        flatbedv.Value = False
    End If
    If Worksheets("People").Range("AD1000").Text = "yes" Then
        bframev.Value = True
    Else
        bframev.Value = False
    End If
    If Worksheets("People").Range("AF1000").Text = "yes" Then
        cframev.Value = True
    Else
        cframev.Value = False
    End If
    If Worksheets("People").Range("AH1000").Text = "yes" Then
        eframev.Value = True
    Else
        eframev.Value = False
    End If
    If Worksheets("People").Range("AJ1000").Text = "yes" Then
        phevv.Value = True
    Else
        phevv.Value = False
    End If
    If Worksheets("People").Range("AL1000").Text = "yes" Then
        manualv.Value = True
    Else
        manualv.Value = False
    End If
    Range("C800:AZ1200").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C800").Select
    ActiveSheet.Range("$C$1:$AM$989").AutoFilter Field:=1
    Range("C22").Select
    Selection.End(xlUp).Select
    Sheets("People").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Home").Select
    Application.ScreenUpdating = True
    GoTo endProc
errHandler:
    MsgBox errMsg
endProc:
    TextBox1.Value = ""
    TextBox1.SetFocus
    Exit Sub
End Sub
Private Sub Clear_Click()
    Dim ctrl        As Control        ' CREATE A CONTROL OBJECT.
    ' LOOP THROUGH EACH CONTROL, CHECK IF THE CONTROL IS A TEXTBOX.
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Value = ""        'CLEAR THE VALUE.
        End If
    Next ctrl
    Dim x           As Control
    For Each x In Me.Controls
        If TypeOf x Is MSForms.CheckBox Then x.Value = False
    Next
End Sub
 
Upvote 0
Solution
I literally just came across that issue hehe I was just about to type it into google and then seen the notification 😅 wow that's exceptional I'm very happy with
what you've achieved here, many thanks Jimmy great work 💪
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
VBA Userform Textbox Date Format
2
Replies
12
Views
1K
pure vito
P
P
  • Question
Userform Listbox Edit Rows Within Sheet
Replies
1
Views
454
pure vito
P
P
  • Solved
Userform textbox populated with listbox data how to edit
Replies
6
Views
536
pure vito
P
D
  • Question
VBA to hide rows when a cell is a specific value and then hide the associated worksheet
Replies
3
Views
408
NoSparks
N
G
  • Question
Email from Excel query
Replies
0
Views
185
gmazza76
G

Forum statistics

Threads
1,215,400
Messages
6,124,702
Members
449,180
Latest member
craigus51286

Share this page

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
Back
Top