VBA Runtime Error 3131 MS access 2016 Pro Plus - vba

so the below code says there is an issue; however, I can not figure it out.
I am trying to create a search form, and VBA keeps telling me this is wrong. I am not at all a coding person, but just doing this for a project I'm on. any help is greatly appreciated.
Private Sub search_Click()
Dim strsearch As String
Dim Task As String
'Check if a keyword entered or not
If IsNull(Me.txtSearch) Or Me.txtSearch = "" Then
MsgBox "Please type last name of client.", vbOKOnly, "Keyword Needed"
Me.txtSearch.BackColor = vbYellow
Me.txtSearch.SetFocus
Else
strsearch = Me.txtSearch.Value
Task = "SELECT * FROM tbl_table-application WHERE ((Last_Name Like ""*" & strsearch & "*""))"
** Me.RecordSource = Task**
Me.txtSearch.BackColor = vbWhite
End If
End Sub

Table name has hyphen character so need to enclose in [ ]: [tbl_table-application]. Advise not to use spaces nor punctuation/special characters in naming convention. Only underscore is acceptable exception that will work without [ ].

Related

entering iferror and left formulas to vba [duplicate]

I want to insert an if statement in a cell through vba which includes double quotes.
Here is my code:
Worksheets("Sheet1").Range("A1").Value = "=IF(Sheet1!B1=0,"",Sheet1!B1)"
Due to double quotes I am having issues with inserting the string. How do I handle double quotes?
I find the easiest way is to double up on the quotes to handle a quote.
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0,"""",Sheet1!A1)"
Some people like to use CHR(34)*:
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0," & CHR(34) & CHR(34) & ",Sheet1!A1)"
*Note: CHAR() is used as an Excel cell formula, e.g. writing "=CHAR(34)" in a cell, but for VBA code you use the CHR() function.
Another work-around is to construct a string with a temporary substitute character. Then you can use REPLACE to change each temp character to the double quote. I use tilde as the temporary substitute character.
Here is an example from a project I have been working on. This is a little utility routine to repair a very complicated formula if/when the cell gets stepped on accidentally. It is a difficult formula to enter into a cell, but this little utility fixes it instantly.
Sub RepairFormula()
Dim FormulaString As String
FormulaString = "=MID(CELL(~filename~,$A$1),FIND(~[~,CELL(~filename~,$A$1))+1,FIND(~]~, CELL(~filename~,$A$1))-FIND(~[~,CELL(~filename~,$A$1))-1)"
FormulaString = Replace(FormulaString, Chr(126), Chr(34)) 'this replaces every instance of the tilde with a double quote.
Range("WorkbookFileName").Formula = FormulaString
This is really just a simple programming trick, but it makes entering the formula in your VBA code pretty easy.
All double quotes inside double quotes which suround the string must be changed doubled. As example I had one of json file strings : "delivery": "Standard",
In Vba Editor I changed it into """delivery"": ""Standard""," and everythig works correctly. If you have to insert a lot of similar strings, my proposal first, insert them all between "" , then with VBA editor replace " inside into "". If you will do mistake, VBA editor shows this line in red and you will correct this error.
I have written a small routine which copies formula from a cell to clipboard which one can easily paste in Visual Basic Editor.
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
It is originally posted on Chandoo.org forums' Vault Section.
In case the comment by gicalle ever dies:
I prefer creating a global variable:
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Public Const vbSingleQuote As String = "'" 'represents 1 single quote (')
and using it like so:
Shell "explorer.exe " & vbDoubleQuote & sPath & vbDoubleQuote, vbNormalFocus

How to use VBA .Formula with row number incrementation? [duplicate]

I want to insert an if statement in a cell through vba which includes double quotes.
Here is my code:
Worksheets("Sheet1").Range("A1").Value = "=IF(Sheet1!B1=0,"",Sheet1!B1)"
Due to double quotes I am having issues with inserting the string. How do I handle double quotes?
I find the easiest way is to double up on the quotes to handle a quote.
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0,"""",Sheet1!A1)"
Some people like to use CHR(34)*:
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0," & CHR(34) & CHR(34) & ",Sheet1!A1)"
*Note: CHAR() is used as an Excel cell formula, e.g. writing "=CHAR(34)" in a cell, but for VBA code you use the CHR() function.
Another work-around is to construct a string with a temporary substitute character. Then you can use REPLACE to change each temp character to the double quote. I use tilde as the temporary substitute character.
Here is an example from a project I have been working on. This is a little utility routine to repair a very complicated formula if/when the cell gets stepped on accidentally. It is a difficult formula to enter into a cell, but this little utility fixes it instantly.
Sub RepairFormula()
Dim FormulaString As String
FormulaString = "=MID(CELL(~filename~,$A$1),FIND(~[~,CELL(~filename~,$A$1))+1,FIND(~]~, CELL(~filename~,$A$1))-FIND(~[~,CELL(~filename~,$A$1))-1)"
FormulaString = Replace(FormulaString, Chr(126), Chr(34)) 'this replaces every instance of the tilde with a double quote.
Range("WorkbookFileName").Formula = FormulaString
This is really just a simple programming trick, but it makes entering the formula in your VBA code pretty easy.
All double quotes inside double quotes which suround the string must be changed doubled. As example I had one of json file strings : "delivery": "Standard",
In Vba Editor I changed it into """delivery"": ""Standard""," and everythig works correctly. If you have to insert a lot of similar strings, my proposal first, insert them all between "" , then with VBA editor replace " inside into "". If you will do mistake, VBA editor shows this line in red and you will correct this error.
I have written a small routine which copies formula from a cell to clipboard which one can easily paste in Visual Basic Editor.
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
It is originally posted on Chandoo.org forums' Vault Section.
In case the comment by gicalle ever dies:
I prefer creating a global variable:
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Public Const vbSingleQuote As String = "'" 'represents 1 single quote (')
and using it like so:
Shell "explorer.exe " & vbDoubleQuote & sPath & vbDoubleQuote, vbNormalFocus

How to refill combobox with similar records based on what user types

I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html

MS Access - Text field retuns the querys string instead of the query result value

I have tried a few variations, and all seem to give me the same result - so I am overlooking something pretty simple I think.
I have a text box for an account number, a search button, and a text box for the result of the search query. However, when I hit search - the query itself gets added to the second text box instead of the expected result of 1 or 0.
This is my latest attempt, found on this site:
Private Sub SearchAcctNumber_Click()
Dim strsearch As String
Dim Task As String
If IsNull(Me.Text0) Or Me.Text0 = "" Then
MsgBox "Please type in your account number.", vbOKOnly, "Acct Num Needed"
Me.Text0.SetFocus
Else
strsearch = Me.Text0.Value
Task = "SELECT I_Ind FROM dbo_BC WHERE (([ACCOUNT_NUMBER] Like ""*" & Text0 & "*""))"
Me.Text2 = Task
End If
End Sub
Is anyone able to help me see the error I am making? It is driving me nuts that something so simple isn't working how I thought it should.
Edit: Wanted to add that I've also tried DLookup and get the same result in other iterations of attempts at this.
You may want to reconsider the Like approach in this case. Anyways, the issue is that you assign a string (the SQL command) to the textbox and this is what you see.
Try this instead:
Private Sub SearchAcctNumber_Click()
If IsNull(Text0.Value) Then
MsgBox "Please type in your account number.", vbOKOnly, "Acct Num Needed"
Text0.SetFocus
Exit Sub
End If
Dim strSearch As String
Dim strCriteria As String
strSearch = Text0.Value
strCriteria = "ACCOUNT_NUMBER Like '*" & strSearch & "*'"
Text2.Value = Nz(DLookup("I_Ind", "dbo_BC", strCriteria), "Not found...")
End Sub
You could also "search" while you type on Text0. Set the minimum number of characters before attempting to locate it.
Private Sub Text0_Change()
If Len(Text0.Text) > 3 Then
Text2.Value = Nz(DLookup("I_Ind", "dbo_BC", "ACCOUNT_NUMBER Like '*" & Text0.Text & "*'"), vbNullString)
End If
End Sub
One possible way is, that you change Text2 type to combo box. Then you set Text2.recordsource = Task and you refresh the displayed value with Me.Text2.requery.
Another way is to open a recordset, read the value, and set Text2 value.
Dim r as dao.recordset, db as dao.database
set db = currentdb()
set r=db.openrecordset(Task)
Me.Text2 = r(0).value
Set r = Nothing

Replace Underscores characters with Space inside a String value

This is a rather simple question.
I have a date variables formated like: 25_December_2010
I would like a statement or a bit of code in the VBA macro that will transform that string value from: 25_December_2010 to 25 December 2010.
Somehow be able to remove the underscores from inside the String value....
As I mentioned in comments, use code below:
Dim strDate As String
strDate = "25_December_2010"
strDate = Replace(strDate,"_"," ")
I wanted something similar in a macro I'm using for data cleaning so I took #simoco's answer and created a simple but mostly safe macro/sub.
Sub ConvertSpaceToUnderscore()
Dim strCellValue As String
' Use basic error handling if more than 1 cell is selected, or
' possibly if something that isn't a cell is selected.
On Error GoTo SelectionTooBig
strCellValue = Selection.Value
strCellValue = Replace(strCellValue, " ", "_")
Selection.Value = strCellValue
On Error GoTo 0
' Exit the sub if things went well
Exit Sub
SelectionTooBig:
MsgBox "Please select one cell at a time.", vbCritical, "Selection too large"
End Sub