I have a search bar/box which basically looks up Column A for the string that is searched, then if the string is there it is it filtered on that column and a 1 is added to Column J on that row.
If the string is not in column A then Column B is searched and the same process as above happens where a 1 is added to Column J
The problem i have is sometimes the same string can be in Column A abd B and I want it to go to an error handler routine once that happens. Similarly I want to add 2 more columns and want the search to lookup all columns A-D similar to how A and B were looked up.
The error handler transfers any errors to an Errors tab and works ok for now for column A and B.
The question is what do I need to add to the below to allow for columns C and D to work? The name of these columns C is "Manufacturer ID" and D is "Barcodes"
I made a start below but not sure where to go from here, all help or advice welcomed
If the string is not in column A then Column B is searched and the same process as above happens where a 1 is added to Column J
The problem i have is sometimes the same string can be in Column A abd B and I want it to go to an error handler routine once that happens. Similarly I want to add 2 more columns and want the search to lookup all columns A-D similar to how A and B were looked up.
The error handler transfers any errors to an Errors tab and works ok for now for column A and B.
The question is what do I need to add to the below to allow for columns C and D to work? The name of these columns C is "Manufacturer ID" and D is "Barcodes"
I made a start below but not sure where to go from here, all help or advice welcomed
VBA Code:
Sub SearchBox()
Dim headingoptions As OptionButton
Dim SearchString As String
Dim ButtonName As String
Dim mySearch As String
Dim binloc As String
Dim myFilterField As Long
Dim ProductDataRange As Range
Dim st As Worksheet
Dim ProductResults As Range
Dim prid As String
Dim SupSKU As String
Dim manuSKU As String
Dim BarcodSK As String
Dim notfnd As Long
Dim NextErrorBinCell As Range
Dim NextErrorSKUCell As Range
Dim NextErrorQtyCell As Range
Set st = Sheets("StockTake")
'Unfilter Data (if necessary)
On Error Resume Next
st.ShowAllData
On Error GoTo 0
'Filtered Data Range
totalproducts = Application.WorksheetFunction.CountA _
(Range("A1", Range("A" & Rows.Count).End(xlUp)))
totalproducts = totalproducts + 1
Set ProductDataRange = Range("A6:I" & totalproducts)
'Retrieve User's Search Input
mySearch = ScanningBox.Text
binloc = BinLocationTextBox.Value
'If mysearch is empty then end sub
If mySearch = "" Then
GoTo BtnError_Handler
Else
'Checks to see if user is using Lookup function or stocktake constant scan method
If st.Shapes("LookupCheckBox").ControlFormat.Value = 1 Then
'The method below does a wild card search on what ever column heading is choosen above the scan field
'Determine if user is searching for number or text
If IsNumeric(mySearch) = True Then
SearchString = "*" & mySearch & "*"
Else
SearchString = "*" & mySearch & "*"
End If
'Loop Through Heading Option Buttons To Find The One Being Used
For Each headingoptions In st.OptionButtons
If headingoptions.Value = 1 Then
ButtonName = headingoptions.Text
Exit For
End If
Next headingoptions
'Determine Filter Field
myFilterField = WorksheetFunction.Match(ButtonName, ProductDataRange.Rows(1), 0)
'Filter Data and find the product
ProductDataRange.AutoFilter _
Field:=myFilterField, _
Criteria1:=SearchString, _
Operator:=xlAnd
checkforresults = 0
Set ProductResults = st.Range("A6:A200000").Columns(1).SpecialCells(xlCellTypeVisible)
checkforresults = WorksheetFunction.CountA(ProductResults)
If checkforresults = 1 Then
'this means there is only header row and no filtered rows thus the product does not exist so the message below is displayed and the the sub is ended
MsgBox "Product Not Found in List!"
On Error GoTo BtnError_Handler
End If
'clear the search box as the product was found
ScanningBox.Text = ""
Else
'Determine if user is searching for number or text
Application.ScreenUpdating = False
prid = "Product ID"
SupSKU = "Supplier SKU"
manuSKU = "Manufacturer SKU"
BarcodSK = "Barcodes"
'Determine Filter Field
If IsEmpty(Range("A1").Value) = True Then
MsgBox "No Stocktake file imported!"
GoTo HeadingError_Handler
Else
myFilterField = WorksheetFunction.Match(prid, ProductDataRange.Rows(1), 0)
End If
'Filter Data on Product ID column and add a count of 1 to the product found if no product found is found it checks the Suppleir SKU column
ProductDataRange.AutoFilter _
Field:=myFilterField, _
Criteria1:=mySearch, _
Operator:=xlAnd
Set ProductResults = st.Range("A6:A200000").Columns(1).SpecialCells(xlCellTypeVisible)
checkforresults = WorksheetFunction.CountA(ProductResults)
If checkforresults > 2 Then
On Error GoTo SupplierSKUFilter
Range("J7:J" & totalproducts).SpecialCells(xlCellTypeVisible).Value = Range("J7:J" & totalproducts).SpecialCells(xlCellTypeVisible).Value + 1
ElseIf checkforresults = 1 Then
st.ShowAllData
'Determine Supplier SKU Filter Field
SupplierSKUFilter:
myFilterField = WorksheetFunction.Match(SupSKU, ProductDataRange.Rows(1), 0)
If st.AutoFilterMode = True Then
Cells.AutoFilter
End If
'Filter Data on Supplier SKU
ProductDataRange.AutoFilter _
Field:=myFilterField, _
Criteria1:=mySearch, _
Operator:=xlAnd
Set ProductResults = st.Range("A6:A200000").Columns(1).SpecialCells(xlCellTypeVisible)
checkforresults = WorksheetFunction.CountA(ProductResults)
If checkforresults > 1 Then
On Error GoTo ScdError_Handler
Range("J7:J" & totalproducts).SpecialCells(xlCellTypeVisible).Value = Range("J7:J" & totalproducts).SpecialCells(xlCellTypeVisible).Value + 1
ElseIf checkforresults = 1 Then
On Error GoTo ScdError_Handler
'Product scanned was not found in the data set so grab that scanned product and put it into the Errors worksheet and beep
ScdError_Handler:
Application.ScreenUpdating = False
Beep
ProductScanned = ScanningBox.Value
counterrorsalreadyinlist = Sheets("Errors").Range("A" & Rows.Count).End(xlUp).Row + 1
Set NextErrorSKUCell = Sheets("Errors").Range("A" & counterrorsalreadyinlist)
NextErrorSKUCell.Cells.Value = mySearch
NextErrorSKUCell.Offset(, 1).Value = binloc
NextErrorSKUCell.Offset(, 2).Value = 1
Application.ScreenUpdating = True
End If
End If
'On lookup product not found it comes to here
HeadingError_Handler:
BtnError_Handler:
'Clear Search Field
ScanningBox.Text = ""
End If
End If
'Activate scannning box for next product
ScanningBox.Activate
End Sub