Everytime I execute my Macro (below) to search for a string that is entered into my search box, I get a Runtime error '1004'. AutoFilter method of Range class failed. I've tried looking for an answer to this problem on here for a while but nothing seems to provide me with a solution.
When I hit 'Debug' it highlights the below section of the code.
DataRange.AutoFilter _
Field:=myField, _
Criteria1:=SearchString, _
Operator:=xlAnd
I realise that this isn't much info but any help would be extremely appreciated.
P.S. I'm a complete novice with VBA and copied the code off a website that did a step by step guide to creating a search filter in Excel.
Sub SearchBox()
Dim myButton As OptionButton
Dim SearchString As String
Dim ButtonName As String
Dim sht As Worksheet
Dim myField As Long
Dim DataRange As Range
Dim mySearch As Variant
'Load Sheet into A Variable
Set sht = ActiveSheet
'Unfilter Data (if necessary)
On Error Resume Next
sht.ShowAllData
On Error GoTo 0
'Filtered Data Range (include column heading cells)
Set DataRange = sht.Range("A5:Z40000") 'Cell Range
'Set DataRange = sht.ListObjects("Table1").Range 'Table
'Retrieve User's Search Input
mySearch = sht.Shapes("UserSearch").TextFrame.Characters.Text 'Control Form
'mySearch = sht.OLEObjects("UserSearch").Object.Text 'ActiveX Control
'mySearch = sht.Range("A1").Value 'Cell Input
'Determine if user is searching for number or text
If IsNumeric(mySearch) = True Then
SearchString = "=" & mySearch
Else
SearchString = "=*" & mySearch & "*"
End If
'Loop Through Option Buttons
For Each myButton In sht.OptionButtons
If myButton.Value = 1 Then
ButtonName = myButton.Text
Exit For
End If
Next myButton
'Determine Filter Field
On Error GoTo HeadingNotFound
myField = Application.WorksheetFunction.Match(ButtonName, DataRange.Rows(1), 0)
On Error GoTo 0
'Filter Data
DataRange.AutoFilter _
Field:=myField, _
Criteria1:=SearchString, _
Operator:=xlAnd
'Clear Search Field
sht.Shapes("UserSearch").TextFrame.Characters.Text = "" 'Control Form
'sht.OLEObjects("UserSearch").Object.Text = "" 'ActiveX Control
'sht.Range("A1").Value = "" 'Cell Input
Exit Sub
'ERROR HANDLERS
HeadingNotFound:
MsgBox "The column heading [" & ButtonName & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"
End Sub
check the value of myField, it must be between 1 and 26 because your range is A -> Z.
Related
In the code below I'm looking to implement a check that verifies the correct file is being selected before executing the rest of the code. Once the 'combinedbook' is open a check will be carried out that verifies certain text is in a certain cell within the workbook. For example, in the code below I need the check to verify that the text "Cash Split" is contained in cell B2 in the combinedWorkbook before carrying out the vlookup and if not to stop executing the code and provide a warning message box.
Sub ImportWriteOffs()
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
' Open BRAM Report Source Data
MsgBox ("Select 'SRMF0035'")
filter = "Text files (*.xlsx),*.xlsx"
caption = "Select 'SRMF0035'"
combinedFilename = Application.GetOpenFilename(filter, , caption)
If combinedFilename <> "False" Then
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
Else
MsgBox "No file was uploaded", vbExclamation
GoTo LastLine
End If
' Conduct Vlookup on BRAM Report
Dim lastRow As Long
With ThisWorkbook.Worksheets("Input Write Offs")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B9:B" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[" & combinedWorkbook.Name & "]Tabular Version'!R10C2:R700000C56,55,0)"
combinedWorkbook.Close False
End With
LastLine:
End Sub
Many thanks,
Kieran
What you just need to do here is to have an additional conditional statement to check first if the cell("B2") contained the certain text that you want.
With ThisWorkbook.Worksheets("Input Write Offs")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If .range("B2") = "Cash Split" Then
.Range("B9:B" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[" & combinedWorkbook.Name & "]Tabular Version'!R10C2:R700000C56,55,0)"
combinedWorkbook.Close False
Else:
Msgbox "Display Prompt In Here"
combinedWorkbook.Close False 'To Ensure that the workbook will be close before ending the routine.
exit sub
End if
End With
Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 4 years ago.
Improve this question
I want to create a search text box that filters data in excel. I have 3 columns of data. Car make, model, and color are the columns. I have radio buttons that when selected I want the search button to search based on that column data. For example, if i have the color radio button selected and search "white" I want the results to return all cars that are white. I need the VBA code for excel. Thanks
this is the code I have so far. but it only works with one of the radio buttons, when I change to ad different radio button selection it returns nothing.
Here is the screenshot of the excel sheet
Dim myButton As OptionButton
Dim SearchString As String
Dim ButtonName As String
Dim sht As Worksheet
Dim myField As Long
Dim DataRange As Range
Dim mySearch As Variant
'Load Sheet into A Variable
Set sht = ActiveSheet
'Unfilter Data (if necessary)
On Error Resume Next
sht.ShowAllData
On Error GoTo 0
'Filtered Data Range (include column heading cells)
Set DataRange = sht.Range("A3:F92") 'Cell Range
'Set DataRange = sht.ListObjects("Table1").Range 'Table
'Retrieve User's Search Input
'mySearch = sht.Shapes("UserSearch").TextFrame.Characters.Text 'Control Form
mySearch = sht.OLEObjects("txtSearch").Object.Text 'ActiveX Control
'mySearch = sht.Range("A1").Value 'Cell Input
'Determine if user is searching for number or text
If IsNumeric(mySearch) = True Then
SearchString = "=" & mySearch
Else
SearchString = "=*" & mySearch & "*"
End If
'Loop Through Option Buttons
For Each myButton In sht.OptionButtons
If myButton.Value = 1 Then
ButtonName = myButton.Text
Exit For
End If
Next myButton
'Determine Filter Field
On Error GoTo HeadingNotFound
myField = Application.WorksheetFunction.Match(ButtonName, DataRange.Rows(1), 0)
On Error GoTo 0
'Filter Data
DataRange.AutoFilter _
Field:=myField, _
Criteria1:=SearchString, _
Operator:=xlAnd
'Clear Search Field
'sht.Shapes("UserSearch").TextFrame.Characters.Text = "" 'Control Form
sht.OLEObjects("txtSearch").Object.Text = "" 'ActiveX Control
'sht.Range("A1").Value = "" 'Cell Input
Exit Sub
'ERROR HANDLERS
HeadingNotFound:
MsgBox "The column heading [" & ButtonName & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"
End Sub
I am tasked with pulling two specific rows of data from monthly sheets in a workbook.
Current code, using MyVal and a search box, is only compatible with one search. How can I change the code & searchbox function to be compatible with multiple searches?
Current code looks like this:
Sub Set_Hyper()
' Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
' {i} will act as our counter
Dim i As Long
' Use an input box to type in the search criteria
Dim MyVal As String
MyVal = InputBox("What are you searching for", "Search-Box", "")
' if we don't have anything entered, then exit the procedure
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Add a heading to the sheet with the specified search value
With Cells(1, 1)
.Value = "Found " & MyVal & " in the Link below:"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
i = 2
' Begin looping:
' We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "Data" Then
' We are checking all cells, we don't need the SpecialCells method
' the Find method is fast enough
With wks.Range("A:A")
' Using the find method is faster:
' Here we are checking column "A" that only have {myVal} explicitly
Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)
' If something is found, then we keep going
If Not rCell Is Nothing Then
' Store the first address
fFirst = rCell.Address
Do
' Link to each cell with an occurence of {MyVal}
rCell.Hyperlinks.Add Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 2)
Set rCell = .FindNext(rCell)
i = i + 1 'Increment our counter
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
' Explicitly clear memory
Set rCell = Nothing
' If no matches were found, let the user know
If i = 2 Then
MsgBox "The value {" & MyVal & "} was not found on any sheet", 64, "No Matches"
Cells(1, 1).Value = ""
End If
' Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I'm thinking what you could do is create a UserForm with the following controls:
A text box
A Listbox
A button to add text to the listbox
Another button to run the VBA
The Textbox can hold the search string(s). You can make an event when you click the button to do the following:
1) Add the text from textbox to the listbox. Lookup the AddItem method to do this.
2) Clear the text box contents, so a new value can be added.
Once that's added you can add another for loop around your code to go through each item added to the listbox. That way you can do multiple searches based on what was added.
Hopefully this helps :)
I want to write a macro that will pick a particular value (in my case, stored in cell A1) from a dropdown list (in my case, in cell D6).
Here's what I have so far:
sr_par2 = Array ("TEXT", 'TEXT2", "TEXT3")
sr = Range("A1").Value
(...)
Dim i As Integer
i = 0
Range("D6").Select
Do While (sr <> ActiveCell.FormulaR1C1)
Range("D6").Select
ActiveCell.FormulaR1C1 = sr_par2(i)
i = i + 1
Loop
Is this what you are trying? I have commented the code so that you will not have a problem understanding it. Still if you do then simply ask :)
Sub Sample()
Dim ws As Worksheet
Dim rngIn As Range, rngOut As Range
Dim MyAr
Dim sFormula As String
Dim i As Long
'~~> Replace this with the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Set your input and output range here
Set rngIn = .Range("A1")
Set rngOut = .Range("D6")
'~~> Get the validation list if there is one
On Error Resume Next
sFormula = rngOut.Validation.Formula1
On Error GoTo 0
If sFormula = "" Then
'~~> If no validation list then directly populate the value
rngOut.Value = rngIn.Value
Else
'validation list TEXT1,TEXT2,TEXT3
MyAr = Split(sFormula, ",")
'~~> Loop through the list and compare
For i = LBound(MyAr) To UBound(MyAr)
If UCase(Trim(rngIn.Value)) = UCase(Trim(MyAr(i))) Then
rngOut.Value = MyAr(i)
Exit For
End If
Next i
'~~> Check if the cell is still blank. If it is then it means that
'~~> Cell A1 has a value which is not part of the list
If Len(Trim(rngOut.Value)) = 0 Then
MsgBox "The value in " & rngOut.Address & _
" cannot be set as the value you are copying is not part of the list"
End If
End If
End With
End Sub
If I understood correctly, this should do what you want :
sr_par2 = Array("TEXT", "TEXT2", "TEXT3")
sr = Range("A1").Value
Dim i As Integer
i = 0
On Error GoTo Handler
Do While (sr <> sr_par2(i))
i = i + 1
Loop
Range("D6").FormulaR1C1 = sr_par2(i)
Exit Sub
Handler:
MsgBox "Value not in the list", vbCritical + vbOKOnly, "Value not found"
Im new to VBA but i need to do something with it. I want to make input box that add a new sheet with specific name. somehow i can make it after some searching over the forum. here are the steps that i want to do, but i cant make it completely done.
make input box that ask a name of new sheet (it's done).
when the name of sheet is already available then a msg box appear
that it can't make a new sheet but when the opposite happen then a
new sheet is made (it's done too).
the last is i want to make when the input box is blank a new msg box
appear and ask to enter different name (this i can't do).
Here's the code im using so far
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If NamaSheet <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
End If
Loop Until Not shExists Or SheetName = ""
End Sub
Private Function SheetExists(ByVal SheetName As String, _
Optional ByVal wb As Workbook)
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = Not wb.Worksheets(SheetName) Is Nothing
End Function
any help will be appreciated, thanks in advance for your attention. ah and sorry for my bad english.
Check if this code helps you:
Just added Else part for you Main If condition where you check If Sheetname is not blank.
Also, You can also uncomment my line Exit Sub if you want to exit subroutine in case of blank input box.
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If SheetName <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
Else
MsgBox "Please enter a sheet name.", vbOKOnly + vbInformation, "Warning"
'Exit Sub
End If
Loop Until Not shExists Or SheetName = ""
End Sub
This code caters for errors for either:
the sheet name already existing
the sheet name being invalid (empty (ie ""), too long or invalid characters)
Code updates so sheet name is validated for length, and then by a Regexp for Valid characters for Excel sheet names before the sheet is created
If either 1 or 2 is true the user is re-prompted (with an additional try again message)
Public Sub CariSheet()
Dim SheetName As String
Dim bFinished As Boolean
Dim strMsg As String
Dim ws As Worksheet
Do While Not bFinished
SheetName = InputBox("Pls enter the name of the sheet", strMsg, "Add Sheet")
On Error Resume Next
Set ws = Sheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Select Case Len(SheetName)
Case 0
strMsg = "Sheet name is blank"
Case Is > 31
strMsg = "Sheet name exceeds 31 characters"
Case Else
If ValidSheetName(SheetName) Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = SheetName
Else
strMsg = "Sheet name has invalid characters"
End If
End Select
Else
strMsg = "Sheet exists"
Set ws = Nothing
End If
Loop
End Sub
test for valid sheet name
Function ValidSheetName(strIn As String) As Boolean
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "[\<\>\*\\\/\?|]"
ValidSheetName = Not objRegex.test(strIn)
End Function