Two TextBox one Answer VBA6 - excel

In my UserForm, I have two Text Box. I want to be able to FIND by either Text Box, but use only one or the other. If both are empty I want a MSGBOX telling user to enter information. I can make my code do either/or text box entry but not two textbox where the user skips TextBox1 or does not entry anything.
Here is my code.....
Private Sub OkayCommandButton_Click()
Worksheets("Parts List").Select
Application.ScreenUpdating = False
Range("A2").Select
PN = PartNumber.Value
KN = KanbanNumber.Value
If PartNumber = vbNullString Then
MsgBox "Please enter a Part Number"
PartNumber.SetFocus
Else
Cells.find(What:=PN, After:=Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
If Kanban = vbNullString Then
MsgBox "Please enter a Kanban Number"
PartNumber.SetFocus
Else
Cells.find(What:=KN, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
PartInformation.Caption = _
"Part Number" & vbTab & ActiveCell & vbCrLf & _
"Kanban" & vbTab & vbTab & ActiveCell.Offset(0, 45) & vbCrLf & _
"Part Name" & vbTab & ActiveCell.Offset(0, 1) & vbCrLf & _
"Supplier" & vbTab & vbTab & ActiveCell.Offset(0, 2) & vbCrLf & _
"Next Process" & vbTab & ActiveCell.Offset(0, 3) & vbCrLf & _
"Qty in Tote" & vbTab & ActiveCell.Offset(0, 44) & vbCrLf & _
"PC Location" & vbTab & ActiveCell.Offset(0, 46)
PartInformation1.Caption = "Line " & ActiveCell.Offset(0, -1)
End Sub

You could check first if both TextBox-Elements are empty and then give a message to the user. If that check fails either one or both Text-Box-Elements contain text. You have a conflict there, since you only want to use one TextBox-Element for the search if both textboxes contain a search string. In this case you have to give one of the textboxes priority (the first one you check then wins):
This is only a snippet of your text:
PN = PartNumber.Value
KN = KanbanNumber.Value
If ((PartNumber = vbNullString) And (KanbanNumber = vbNullstring)) Then
' Both textboxes are empty, message box opened and focus to part number
MsgBox "Please enter a Part Number or Kanban Number"
PartNumber.SetFocus
Else
' One or more textboxes contain a search string
If Not (PartNumber = vbNullString) Then
'Part number is given, run search
Cells.find(What:=PN, After:=Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Else
' Part Number is not given
' Since we checked that at least one textbox contains text
' the Kanban Number must be set if Part Number has not been set
Cells.find(What:=KN, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
End If

Related

Proceeding to back to userform to make correction

I have code that I want to check to make sure that the barcodes entered using a userform is valid and it is available to be sold. My problem is after it finishes checking, it does not allow me to make edits on the userform anymore.
I have designed the code for each line of item.
Private Sub PriceTextBox1_AfterUpdate()
Dim bccs1 As String
Dim bcce1 As String
bccs1 = BarcodeStartNumber1TextBox.Text
bcce1 = BarcodeEndNumber1TextBox.Text
MsgBox ("Please wait for a few moment while the barcodes are validated.")
On Error GoTo bccErrorHandler1
If DescriptionTextBox1.Text = "Deep Penetrating Sealant (DPS)" _
Or DescriptionTextBox1.Text = "Top Seal (TS)" Then
Sheets("Inventory Log").Select
Columns("J:J").Select
Selection.Find(what:=bccs1, after:=ActiveCell, LookIn:=xlFormulas, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
Do
If ActiveCell.Offset(0, 1).Value = "In" Then
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell.Offset(0, 1).Value = "Out" Then
MsgBox ("Barcode" & ActiveCell.Value & " has already been sold")
If ActiveCell = bbce1 Then Exit Do
MsgBox ("The barcode batch " & bccs1 & " to " & bcce1 & _
" are available")
End If
Loop
End If
bbccErrorHandler1:
MsgBox ("The barcode you have entered is invalid. Please check entry.")
Exit Sub
End Sub

Make a list in VB Excel based on cells in the same row

I have a worksheet with names and addresses of people. I want to make a Userform that finds a person in Column 1 and then output the data from the following cells in the same row as a list. So the output would look like this:
John
Time Squares 12
New York
0123123123
I manage to find the cell and output the information, but I can't find a way to find and add the info in the following cells in the same row.
Dim FindString As String
Dim Rng As Range
FindString = txtSearch
If Trim(FindString) <> "" Then
With Sheets("servicepartner").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
MailFormat.Text = Rng.Value & vbNewLine
Else
MsgBox "Nothing found"
End If
End With
End If
Anyone have a suggestion on how to approach this issue? Thanks!
I solved this by setting up a variable (StringRow) with the rownumber of the search result. Then output Cells( StringRow, "B").Value & vbNewLinge & Cells( StringRow, "C") $ etc. etc. Works fine!
The code now looks like this:
Dim FindString As String
Dim Rng As Range
'This variable will find the Row number
Dim StringRow As Long
FindString = txtSearch
If Trim(FindString) <> "" Then
With Sheets("servicepartner").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Output Results (i shorted this to not give you a headache)
StringRow = Rng.Row
MailFormatKlant.Text = Rng.Value & vbNewLine & _
Sheets("servicepartner").Cells(StringRow, "B").Value & _
vbNewLine & Sheets("servicepartner").Cells(StringRow, "D").Value & _
" te " & Sheets("servicepartner").Cells(StringRow, "C").Value & _
vbNewLine & Sheets("servicepartner").Cells(StringRow, "F").Value & _
vbNewLine & Sheets("servicepartner").Cells(StringRow, "G").Value & _
Else
MsgBox "Nothing found"
End If
End With
End If
I hope someone finds this helpful :)
Here's what I was suggesting.
MailFormatKlant.Text = Rng.Value & _
vbNewLine & Rng.Offset(0,1).Value & vbNewLine & _
vbNewLine & Rng.Offset(0,3).Value & vbNewLine & _
vbNewLine & " te " & Rng.Offset(0,2).Value & vbNewLine & _
vbNewLine & Rng.Offset(0,5).Value & vbNewLine & _
vbNewLine & Rng.Offset(0,6).Value

Find value from columns

I have two sheets.
Data
Column A Column B Column C Column D Column E
1234
Sheet 1
Cell N3 = 1234
I am using this code to try and find the value in columns A-E.
But for some reason it always returns the wrong result.
Set c = Selection.Find(What:=Worksheets(1).Range("N3").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Please can someone show me where I am going wrong?
Full Code:
Sub PhoneBook()
'Start Phone Book Directory Code
Dim Contact As String
Dim Email As String
Dim Phone As String
Dim Fax As String
'Start FIND
Dim c As Variant
With Worksheets("Contacts").Range("A2:E10000")
Set c = Selection.Find(What:=Worksheets(1).Range("N3").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If c Is Nothing Then
'Introduce FailSafe, escape code if no result found
ThisWorkbook.Worksheets(1).Shapes("Suggest").Visible = False
ThisWorkbook.Worksheets(1).Shapes("Close").Visible = False
'ActiveSheet.Unprotect Password:="SecretPassword"
Else
'Check values are not blank
If c.Offset(0, 1).Value <> "" Then
Contact = "Contact: " & c.Offset(0, 1).Value & Chr(10)
Else
Contact = "Contact: No Contact Held" & Chr(10)
End If
If c.Offset(0, 2).Value <> "" Then
Email = "Email: " & c.Offset(0, 2).Value & Chr(10)
Else
Email = "Email: No Email Held" & Chr(10)
End If
If c.Offset(0, 3).Value <> "" Then
Phone = "Phone: " & c.Offset(0, 3).Value & Chr(10)
Else
Phone = "Phone: No Phone Held" & Chr(10)
End If
If c.Offset(0, 4).Value <> "" Then
Fax = "Fax: " & c.Offset(0, 4).Value
Else
Fax = "Fax: No Fax Held"
End If
If IsNumeric(c.Value) Then
what_found = c.Offset(0, 1).Value
Else
what_found = c.Value
End If
'Show Contacts
ThisWorkbook.Worksheets("Data").Range("I2").Value = "Hello," & vbNewLine & "Have you tried to contact " & what_found & " about your issue?" & vbNewLine _
& Contact & Email & Phone & Fax
'ThisWorkbook.Worksheets(1).Shapes("Suggest").TextFrame.AutoSize = True
CenterShape ThisWorkbook.Worksheets(1).Shapes("Suggest")
RightShape ThisWorkbook.Worksheets(1).Shapes("Close")
ThisWorkbook.Worksheets(1).Shapes("Suggest").Visible = True
'Show Close Button
'ThisWorkbook.Worksheets(1).Shapes("Close").OnAction = "HideShape"
ThisWorkbook.Worksheets(1).Shapes("Close").Visible = True
'Protect sheet
'ActiveSheet.Protect Password:="SecretPassword", userinterfaceonly:=True
'ActiveSheet.Shapes("Suggest").Locked = True
End If
End With
End Sub
Public Sub CenterShape(o As Shape)
o.Left = ActiveWindow.VisibleRange(1).Left + (ActiveWindow.VisibleRange.Width / 2 - o.Width / 2)
o.Top = ActiveWindow.VisibleRange(1).Top + (ActiveWindow.VisibleRange.Height / 2 - o.Height / 2)
End Sub
Public Sub RightShape(o As Shape)
o.Left = ThisWorkbook.Worksheets(1).Shapes("Suggest").Left + (ThisWorkbook.Worksheets(1).Shapes("Suggest").Width / 1.01 - o.Width / 1.01)
o.Top = ThisWorkbook.Worksheets(1).Shapes("Suggest").Top + (ThisWorkbook.Worksheets(1).Shapes("Suggest").Height / 30 - o.Height / 30)
End Sub
You need not use selection. it check range only in selection.
if you know the range to be checked as With Worksheets("Contacts").Range("A2:E10000") then
Change the code as shown below
Set c = .Find(What:=Worksheets(1).Range("N3").Value, After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
As Jeeped suggested, remove the Selection object for your range and instead use the range you defined at the “With” statement. Also, I changed the “After” argument to be a reference to the first cell in the range defined at the “With” statement; and, the “LookIn” argument was changed to be xlValues.
...
With Worksheets("Contacts").Range("A2:E10000")
Set c =.Find(What:=Worksheets(1).Range("N3").Value, After:=.Cells(1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
...
This search looks at all the columns from A to E. The Find method could return a reference to a cell in a column other than column A if it found a matching value. This may be producing some unusual results for the rest of your code because you are using offset to get the other contact numbers. You may want to consider defining constants for each column and use those with a call to the Cells property using the a constant for the "Column" parameter.
For Example:
Declare your constants for the columns at the beginning of Phonebook().
Const lCOLUMN_EMAIL as long = 3
Use the Cells property for returning values as with the email example below:
If .Cells(c.Row, lCOLUMN_EMAIL).Value <> "" Then
Email = "Email: " & .Cells(c.Row, lCOLUMN_EMAIL).Value & Chr(10)
Else
Email = "Email: No Email Held" & Chr(10)
End If
Limit your search to the A column or which ever column contains the values. (Ignore this part if you want to search all the cells in all the columns.)
Set c = .Columns(1).Find(What:=Worksheets(1).Range("N3").Value, After:=.Cells(1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False

If a FIND fails to find input VBA6

It has just dawned on me What if the user puts in something not in the database (excel spreadsheet)? I have poured over all these posted fixes and none seem to meet my needs. Would someone look over my code Please.
Private Sub OkayCommandButton_Click()
Worksheets("Parts List").Select
Application.ScreenUpdating = False
Range("A2").Select
PN = PartNumber.Value
KN = KanbanNumber.Value
If ((PartNumber = vbNullString) And (KanbanNumber = vbNullString)) Then
' Both textboxes are empty, message box opened and focus to part number
MsgBox "Please enter a Part Number or Kanban Number"
PartNumber.SetFocus
Else
' One or more textboxes contain a search string
If Not (PartNumber = vbNullString) Then
'Part number is given, run search
Cells.find(What:=PN, After:=Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Else
' Part Number is not given
' Since we checked that at least one textbox contains text
' the Kanban Number must be set if Part Number has not been set
Cells.find(What:=KN, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
End If
PartInformation.Caption = _
"Part Number" & vbTab & ActiveCell & vbCrLf & _
"Kanban" & vbTab & vbTab & ActiveCell.Offset(0, 45) & vbCrLf & _
"Part Name" & vbTab & ActiveCell.Offset(0, 1) & vbCrLf & _
"Supplier" & vbTab & vbTab & ActiveCell.Offset(0, 2) & vbCrLf & _
"Next Process" & vbTab & ActiveCell.Offset(0, 3) & vbCrLf & _
"Qty in Tote" & vbTab & ActiveCell.Offset(0, 44) & vbCrLf & _
"PC Location" & vbTab & ActiveCell.Offset(0, 46)
PartInformation1.Caption = "Line " & ActiveCell.Offset(0, -1)
End Sub
The specification for Range.Find is that it returns Nothing if the search term doesn't exist in the searched area. Nothing is a special value which you can test for.
To deal with search terms which don't exist, try adding Dim rFindResult As Range immediately after the Private Sub... line and then alter the Cells.Find statements like this:
Set rFindResult = Cells.Find(What:=KN, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If (rFindResult Is Nothing) Then
` display MesgBox, reset focus appropriately, exit sub
Else
rFindResult.Activate
End If
Siddarth Rout's point about specifying which sheet to use rather than implicitly relying on the active sheet is well worth heeding. Also, in the case where neither part number nor kanban number is specified, there should probably be an Exit Sub after setting the focus to part number

How to get VBA hyperlinks working?

I tried to use hyperlinks but it is not doing anything at all. I would like to know what I need to change to use hyperlinks please.
Sub RDB_Worksheet_To_PDF()
Dim FileName As String
Dim PONumber As String
Dim FolderPath As String
PONumber = Sheets("Purchase Order with Sales Tax").Cells(8, 6).Value
FolderPath = "Z:\1.PRODUCTION\1. PURCHASING\PO H 2012\"
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"be aware that every selected sheet will be published"
End If
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveSheet, FolderPath & PONumber, True, True)
If FileName <> FolderPath & PONumber Then
'Ok, you find the PDF where you saved it
'You can call the mail macro here if you want
MsgBox "Sweet! The PO has been saved as a PDF." & vbNewLine & _
"Click on the PO Number in the PO Number WorkSheet to view."
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"There is no PO number selected" & vbNewLine & _
"The path to Save the file in is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
Sheets("PO Number").Select
Range("A1").Select
Set smvar = Cells.Find(What:=PONumber, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not smvar Is Nothing Then smvar.Activate
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
FolderPath & PONumber & ".pdf"
Sheets("Purchase Order with Sales Tax").Select
End Sub
This works for me - adapt to suit.
Sub Tester()
Dim shtPO As Worksheet, smvar As Range
Set shtPO = Sheets("Sheet1")
Set smvar = shtPO.Cells.Find(What:="Hello", _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart)
If Not smvar Is Nothing Then
shtPO.Hyperlinks.Add Anchor:=smvar, Address:="C:\folder\folder2\file.pdf"
End If
End Sub
No need to select/activate anything.
Not sure if I understood the issue very clearly...
But may you should select the sheet first then create the Hyperlink...
Sub createHyperLink()
Sheets("Purchase Order with Sales Tax").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:="example.pdf", _
ScreenTip:="This is the link file", _
TextToDisplay:="Linked PDF"
End Sub
This would create the link in the default selected cell in sheet named "Purchase Order with Sales Tax"

Resources