VBA - Userform Data entry - Prompt if VLOOKUP error (#n/a)

andrewfoss01

New Member
Joined
Feb 7, 2021
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
I have a excel file that is designed for entering drawing numbers to use as a register. The file is design to search a part of the drawing number and relate it to a client # on a different sheet. I want my userform to prompt the user if no return is found relating the newly entered drawing number with a client.
Capture1.PNG

For example; drawing # LN005555-001-SK_0 relates that LN005555 must be client "John Doe"
if no client is found, and returns "#N/A", than a prompt is made to enter new Client information, and activate another userform to enter new client information.

Capture2.PNG


My VBA skills are extremely limited. Who can help me out with this?

The new client entry userform name is called "job_entry"
I'd like to have a custom prompt to say "Please Enter New Job & Client Information"


my code thus far:

Code:
Private Sub UserForm_Initialize()
    Dim Sht As Worksheet

    For Each Sht In Worksheets
        If Sht.AutoFilterMode = True Then
            Debug.Print Sht.Name
            Sht.AutoFilterMode = False
        End If
    Next

   Dim TodaysDate As String
  
    TodaysDate = Format(Now(), "dd/mmm/yyyy")
  
    txt_date_create.Value = TodaysDate
  
End Sub



Private Sub add_data_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DWG LIST")

'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
iRow = Worksheets("DWG LIST").Range("A1").End(xlDown).Row + 1


'check for a drawing number
If Trim(Me.txt_dwg_num.Value) = "" Then
  Me.txt_dwg_num.SetFocus
  MsgBox "Please enter a drawing number"
  Exit Sub
End If


With ws
  .Cells(iRow, 1).Value = Me.txt_dwg_num.Value
  .Cells(iRow, 7).Value = Me.txt_date_create.Value
  .Cells(iRow, 8).Value = Me.username1.Value
  .Cells(iRow, 9).Value = Me.txt_ewp_num.Value
  .Cells(iRow, 12).Value = Me.txt_title.Value
End With

'clear the data
Me.txt_dwg_num.Value = ""
Me.txt_ewp_num.Value = ""
Me.txt_title.Value = ""
Me.txt_dwg_num.SetFocus

ActiveSheet.Cells(ActiveSheet.Rows.Count, Selection.Column).End(xlUp).Select

End Sub

Private Sub close_form_Click()
  Unload Me
End Sub
Private Sub txt_dwg_num_Change()
      
       txt_dwg_num.Text = UCase(txt_dwg_num.Text)

End Sub

Private Sub username1_Change()
      
       username1.Text = UCase(username1.Text)

End Sub

Private Sub txt_ewp_num_Change()
      
       txt_ewp_num.Text = UCase(txt_ewp_num.Text)

End Sub

Private Sub txt_title_Change()
      
       txt_title.Text = UCase(txt_title.Text)

End Sub
 

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi, to check drawing number and handle #NA error, you can use below:

VBA Code:
Sub vlookupQuery()

    Dim lookupVal As String, lookupRange As Range
    Dim clientAvailable As String, lastRow As Integer
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    lookupVal = job_entry.txt_dwg_num.text
    lookupRange = Sheets("Sheet1").Range("A1:D" & lastRow)
    
    On Error GoTo notFound
    clientAvailable = Application.WorksheetFunction.VLookup(lookupVal, lookupRange, 4, 0)
    
    Exit Sub
notFound:
    MsgBox "Please Enter New Job & Client Information"
    
End Sub
 

andrewfoss01

New Member
Joined
Feb 7, 2021
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
Hi, to check drawing number and handle #NA error, you can use below:

VBA Code:
Sub vlookupQuery()

    Dim lookupVal As String, lookupRange As Range
    Dim clientAvailable As String, lastRow As Integer
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   
    lookupVal = job_entry.txt_dwg_num.text
    lookupRange = Sheets("Sheet1").Range("A1:D" & lastRow)
   
    On Error GoTo notFound
    clientAvailable = Application.WorksheetFunction.VLookup(lookupVal, lookupRange, 4, 0)
   
    Exit Sub
notFound:
    MsgBox "Please Enter New Job & Client Information"
   
End Sub
I get an error:

Capture.JPG
 

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
You need to put the code in module and have to call this sub procedure.

You pasted the code in add_data_Click. According to your code, if drawing number not found the macro should display the message and then exit the sub procedure.
If found then it should add the data in sheet.

Is my understanding correct?
If yes, your method add_data_Click should be as below:

VBA Code:
Private Sub add_data_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DWG LIST")

'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
iRow = Worksheets("DWG LIST").Range("A1").End(xlDown).Row + 1


'check for a drawing number
If Trim(Me.txt_dwg_num.Value) = "" Then
  Me.txt_dwg_num.SetFocus
  MsgBox "Please enter a drawing number"
  Exit Sub
End If

'To check if Drawing number exist in sheet or not.

    Dim lookupVal As String, lookupRange As Range
    Dim clientAvailable As String, lastRow As Integer
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    lookupVal = job_entry.txt_dwg_num.Text
    lookupRange = Sheets("Sheet1").Range("A1:D" & lastRow)
    
    On Error GoTo notFound
    clientAvailable = Application.WorksheetFunction.VLookup(lookupVal, lookupRange, 4, 0)

    With ws
      .Cells(iRow, 1).Value = Me.txt_dwg_num.Value
      .Cells(iRow, 7).Value = Me.txt_date_create.Value
      .Cells(iRow, 8).Value = Me.username1.Value
      .Cells(iRow, 9).Value = Me.txt_ewp_num.Value
      .Cells(iRow, 12).Value = Me.txt_title.Value
    End With



'clear the data
Me.txt_dwg_num.Value = ""
Me.txt_ewp_num.Value = ""
Me.txt_title.Value = ""
Me.txt_dwg_num.SetFocus

ActiveSheet.Cells(ActiveSheet.Rows.Count, Selection.Column).End(xlUp).Select
    
    Exit Sub
notFound:
    MsgBox "Please Enter New Job & Client Information"
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,372
Messages
5,624,301
Members
416,018
Latest member
mirceaon

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