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
Related
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
I have created a userform and one of the commandbuttons launches another userform in which data can be entered into. This data is then added to a table in a worksheet, the userform is then unloaded and the user is returned to the original userform. The error occurs when the data is meant to be entered into the worksheet. This userform works perfectly on its own, but when it is launched from the first userform, this is when the error occurs.
Private Sub CommandButton1_Click()
'check all fields are filled
Dim nextRow As Integer
Dim nextCell As String
If Len(Trim(ComboBox1.Value)) = 0 Then
MsgBox "All feilds must be filled"
Exit Sub
End If
If Len(Trim(TextBox1.Value)) = 0 Then
MsgBox "All feilds must be filled"
Exit Sub
End If
If Len(Trim(TextBox2.Value)) = 0 Then
MsgBox "All feilds must be filled"
Exit Sub
End If
'Check if supplier ID already exists
Dim FindString As String
Dim Rng As Range
FindString = TextBox1.Value
If Trim(FindString) <> "" Then
With Sheet4.Range("B:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, False
MsgBox "Sorry Bro, " & FindString & " already exists!"
Exit Sub
Else
FindString = TextBox2
If Trim(FindString) <> "" Then
With Sheet4.Range("D:D")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, False
MsgBox "Sorry Bro, the Ordering Details you entered:" & vbNewLine & _
"'" & FindString & "'" & vbNewLine & _
"Already exists in our Database!" & vbNewLine & _
"U wanna check ur data?"
Exit Sub
End If
End With
End If
End If
End With
End If
'enter supplier ID into sheet
Sheet4.Activate
nextRow = ActiveSheet.Range("B2", Range("B2").End(xlDown)).Count
nextCell = Cells(nextRow + 2, 2).Activate
'this is where the error occurs
ActiveCell.Value = TextBox1.Value
ActiveCell.Offset(0, 1).Value = ComboBox1.Value
ActiveCell.Offset(0, 2).Value = TextBox2.Value
Sheet2.Activate
Unload Me
End Sub
I'm not sure why it doesn't work because personally I avoid the use of "Activate". Maybe you can try if this works:
'Previous code that worked fine
nextRow = ActiveSheet.Range("B2", Range("B2").End(xlDown)).Count
With ActiveSheet.Cells(nextRow + 2, 2)
.Value = TextBox1.Value
.Offset(0, 1).Value = ComboBox1.Value
.Offset(0, 2).Value = TextBox2.Value
End With
Sheet2.Activate
Unload Me
End Sub
Hope this does the job! (Note that this is my first answer so I'm very open to feedback)
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
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
Forgot the code:
It returns object variable error.
I tried to record a macro but Find doesnt function properly with copy and paste, and then, macro records the actual row I´m in, not a variable.
Instead of Find, I also tried " Cells.AutoFilter Field:=2, Criteria1:=x" but that would return Autofilter range class failed. I´m stuck.
Hope it helps.
Sub alta()
'
' alta Macro
x = Range("I3").Select
Selection.Copy
Selection.Find(What:=x, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.EntireRow.Delete
Range("I3").Select
Selection.ClearContents
End Sub
This should get you started:
Private Sub CommandButton1_Click()
If Range("I3").Value <> "" Then
If IsError(Application.Match(Range("I3"), Range("B3:B20"), 0)) Then
MsgBox ("No Match")
Else
foundRow = Application.Match(Range("I3"), Range("B3:B20"), 0) + 2
Range("A" & foundRow & ":B" & foundRow).Delete Shift:=xlUp
End If
End If
End Sub