I'm trying to delete all the records of one table that appear in another, however it only seems to delete some of the records.
Private Sub removeDuplicates()
Dim resultSet1 As DAO.Recordset
Set resultSet1 = CurrentDb.OpenRecordset("remove")
resultSet1.MoveFirst
Do Until resultSet1.EOF
Dim sql As String
sql = "Delete * from [Copy Of remove] Where"
If Not IsNull(resultSet1.Fields(0)) And (resultSet1.Fields(0) <> "") Then
sql = sql & " PHN = """ & resultSet1.Fields("PHN") & """"
End If
If Not IsNull(resultSet1.Fields(1)) And (resultSet1.Fields(1) <> "") Then
sql = sql & " and Year = " & resultSet1.Fields(1)
End If
If Not IsNull(resultSet1.Fields(2)) And (resultSet1.Fields(2) <> "") Then
sql = sql & " and [Date of Referral to Thoracics] = " & resultSet1.Fields(2)
End If
If Not IsNull(resultSet1.Fields(3)) And (resultSet1.Fields(3) <> "") Then
sql = sql & " and [Date of Thoracics Consult] = " & resultSet1.Fields(3)
End If
If Not IsNull(resultSet1.Fields(4)) And (resultSet1.Fields(4) <> "") Then
sql = sql & " and [Date Thoracic Surgery Booked] = " & resultSet1.Fields(4)
End If
If Not IsNull(resultSet1.Fields(5)) And (resultSet1.Fields(5) <> "") Then
sql = sql & " and [Date of Thoracic Surgery] = " & resultSet1.Fields(5)
End If
If Not IsNull(resultSet1.Fields(6)) And (resultSet1.Fields(6) <> "") Then
sql = sql & " and [Study Group] = """ & resultSet1.Fields(6) & """"
End If
If Not IsNull(resultSet1.Fields(7)) And (resultSet1.Fields(7) <> "") Then
sql = sql & " and [Access Method] = """ & resultSet1.Fields(7) & """"
End If
If Not IsNull(resultSet1.Fields(8)) And (resultSet1.Fields(8) <> "") Then
sql = sql & " and Procedure = """ & resultSet1.Fields(8) & """"
End If
If Not IsNull(resultSet1.Fields(9)) And (resultSet1.Fields(9) <> "") Then
sql = sql & " and Site = """ & resultSet1.Fields(9) & """"
End If
If Not IsNull(resultSet1.Fields(10)) And (resultSet1.Fields(10) <> "") Then
sql = sql & " and [Procedure 2] = """ & resultSet1.Fields(10) & """"
End If
If Not IsNull(resultSet1.Fields(11)) And (resultSet1.Fields(11) <> "") Then
sql = sql & " and [Site 2] = """ & resultSet1.Fields(11) & """"
End If
If Not IsNull(resultSet1.Fields(12)) And (resultSet1.Fields(12) <> "") Then
sql = sql & " and [Primary site] = """ & resultSet1.Fields(12) & """"
End If
If Not IsNull(resultSet1.Fields(13)) And (resultSet1.Fields(13) <> "") Then
sql = sql & " and Grade = """ & resultSet1.Fields(13) & """"
End If
If Not IsNull(resultSet1.Fields(14)) And (resultSet1.Fields(14) <> "") Then
sql = sql & " and [T Stage] = """ & resultSet1.Fields(14) & """"
End If
If Not IsNull(resultSet1.Fields(15)) And (resultSet1.Fields(15) <> "") Then
sql = sql & " and [N Stage] = """ & resultSet1.Fields(15) & """"
End If
If Not IsNull(resultSet1.Fields(16)) And (resultSet1.Fields(16) <> "") Then
sql = sql & " and [M Stage] = """ & resultSet1.Fields(16) & """"
End If
If Not IsNull(resultSet1.Fields(17)) And (resultSet1.Fields(17) <> "") Then
sql = sql & " and [Same Staging?] = """ & resultSet1.Fields(17) & """"
End If
CurrentDb.Execute sql
resultSet1.MoveNext
Loop
resultSet1.Close
End Sub
This is the code I'm using, to test if it works I've been using the table remove and Copy Of Remove but only about 20 of the 135 records are being deleted even though one is a copy of the other.
Also I match all fields when creating the delete query and I have a feeling this is where the issue is coming from.
P.S.
Option explicit and option compare database are declared above this sub
You haven't quoted your date value, so you're doing a division operation:
DELETE ... WHERE [Date...] = 6/5/2013
which becomes
DELETE ... WHERE [Date...] = 0.0005961etc...
Try
DELETE ... WHERE [Date...] = #6/5/2013#
^--------^
instead.
Related
II MAKE MAKING A ACCESS DATABASE.I have a form with a subform and few combo box to use as a filter the data. when there is a blank field in the table it is not shown my coding for the filter is
Function searchcriteria()
Dim device, vlan As String
Dim task, strciteria As String
If IsNull(Me.cbodevice) Then
device = "[DEVICE NAME] like '*'"
Else
device = "[DEVICE NAME]= '" & Me.cbodevice & "'"
End If
If IsNull(Me.cbovlan) Then
vlan = "[VLAN ID] like '*'"
Else
vlan = "[VLAN ID]= '" & Me.cbovlan & "'"
End If
strcriteria = device & "And" & vlan
task = "select * from L2PORTDETAILS where " & strcriteria
Me.L2PORTDETAILS_subform.Form.RecordSource = task
Me.L2PORTDETAILS_subform.Form.Requery
End Function]
It may be simpler just to set the Filter property:
Function SearchCriteria()
' Preset Me!L2PORTDETAILS_subform.Form.RecordSource to:
' "select * from L2PORTDETAILS"
Dim Filter As String
If Not IsNull(Me!cbodevice.Value) Then
Filter = "[DEVICE NAME]= '" & Me!cbodevice.Value & "'"
End If
If Not IsNull(Me!cbovlan.Value) Then
If Filter <> "" Then
Filter = Filter & " And "
End If
Filter = Filter & "[VLAN ID] = '" & Me!cbovlan.Value & "'"
End If
With Me!L2PORTDETAILS_subform.Form
.Filter = Filter
.FilterOn = (Filter <> "")
End With
End Function
I have 8 combo boxes in an Access database. Each combo box can either have a value or not have a value (2 options). In total, there can be 256 combinations (2^8). I am trying to create some code in VBA that loops through these combinations to determine which combination currently exists, with the ultimate goal of writing an SQL query within VBA based on that combination. So for example, let's say combo1 and combo2 both have selections, but not combo3 through combo8. If that is the combination I would like my SQL query to do a SELECT FROM query WHERE a column in db = combo1 and a column in db = combo2. Can anyone provide hints as to how I would structure my code?
Thanks!
Dim a as string, b as string
const myAND as string = "AND "
a = ""
a = "SELECT * FROM a table "
b = ""
if cbo1.value <> "" then
b = b & myAND & "AND field1 = '" & cbo1.value & "'"
end if
if cbo2.value <> "" then
b = b & myAND & "field2 = '" & cbo2.value & "'"
end if
etc for each cbo box
If b <> "" Then
' Lazy way
' a = a & "WHERE 1=1 " & b
' remove the first AND way
a = a & "WHERE 1=1 " & mid(b,len(myAND))
End if
' a now contains the SQL you need.
Dim where_condtion as String
Dim sqlquery as String
where_condtion = ""
IF combo1 <>"" then
where_condtion = where_condtion + "~fieldname~ = " & combo1
End IF
IF combo2 <>"" then
where_condtion = where_condtion + "AND ~fieldname~ = " & combo2
End IF
*
*
*
IF combo8 <>"" then
where_condtion = where_condtion + "AND ~fieldname~ =" & combo8
End IF
IF where_condtion <> "" then
sqlquery = "Select * from ~table name~ where" + where_condtion
ELSE
sqlquery = "Select * from ~table name~
End IF
sqlquery = Replace(sqlquery, "where AND ", "where ")
DoCmd.OpenQuery "sqlquery", acViewNormal, acEdit
OR
CurrentDb.OpenRecordset("sqlquery")
Am option would be a concatenated string
Code Example
Dim strSQL as String
'basic string
strSQL = "SELECT tbl.fieldA, tbl.fieldB FROM tbl "
Dim strSQLwhere as String
strSQLwhere = ""
'Combobox cmbbox1
If Not isNull(cmbbox1) And cmbbox1.ListIndex <> -1 then
strSQLwhere = strSQLwhere & "tbl.fieldToFilter1=" & cmbbox1
End if
'Combobox cmbbox2
If Not isNull(cmbbox2) And cmbbox2.ListIndex <> -1 then
iF NOT strSQLwhere = "" then
strSQLwhere = strSQLwhere & " AND "
end if
strSQLwhere = strSQLwhere & "tbl.fieldToFilter2=" & cmbbox2
End if
'And so on until cmbBox 8
'Combine all Strings
if not strSQLwhere = "" then
strSQL = strSQL & " WHERE (" & strSQLwhere & ")"
End if
'Add here further thing like ORDER BY, GROUP BY
'Show SQL sting if it is well fomratted, change string concatenation if not
debug.print strSQL
You could do the combobox if-then-(else) cases in a separate function if you are able to do that in VBA.
I am trying to create a search form in MS Access 2013, each time i insert the search criteria in any of the fields created i get the error message
"syntax error (missing operator) in query expression "*FROMWHERE (FirstName) like "Godswill""AND"
find below the codes
<blink>
Private Sub cmdSearch_Click()
On Error GoTo errr
Me.qryCandInfo_subform.Form.RecordSource = "SELECT*FROM" & BuildFilter
Me.qryCandInfo_subform.Requery
Exit Sub
errr:
MsgBox Err.Description
End Sub
Private Function BuildFilter() As Variant
Dim varWhere As Variant
Dim tmp As String
tmp = """"
Const conSetDate = "\#dd\/mm\/yyyy\#"
varWhere = Null
If Me.txtEnrNo > "" Then
varWhere = varWhere & "(Enr_No) like " & Me.txtEnrNo & "AND"
End If
If Me.txtFirstName > "" Then
varWhere = varWhere & "(First_Name) like " & tmp & Me.txtFirstName & tmp & "AND"
End If
If Me.txtDateFrom > "" Then
varWhere = varWhere & "((Admisssion_Year)>= " & Format(Me.txtDateFrom, conSetDate) & ") AND"
End If
If Me.txtDateTo > "" Then
varWhere = varWhere & "((Admisssion_Year)<= " & Format(Me.txtDateTo, conSetDate) & ") AND"
End If
If IsNull(varWhere) Then
varWhere = ""
Else
varWhere = "WHERE" & varWhere
If Right(varWhere, 5) = "AND" Then
varWhere = Left(varWhere, Len(varWhere) - 5)
End If
End If
BuildFilter = varWhere
End Function
There is a lot wrong with your code.
To make it easy for you and everybody involved: Add spaces before and after every keyword:
"SELECT*FROM" & BuildFilter => "SELECT * FROM " & BuildFilter
& "AND" => & " AND "
varWhere = "WHERE" & varWhere => varWhere = " WHERE " & varWhere
& ") AND" => & ") AND "
Additionally you are missing to specfify the table you want to select from...
Furthermore your SQL has a trailing AND. Either take care of that or choose the not so perfect approch of appening a 1: varWhere = " WHERE " & varWhere & " 1". (Your version checks for ending with some 5 characters and compare with And - that should NEVER be true...)
Furthermore: SQL-injection... I doubt that pre- and appening """" changes anything
I want to update serial.Issuedate getting from form but its giving syntax error.
Please help me how can I correct this error.
My code is below:
Private Sub Command30_Click()
Set serialrs = CurrentDb.OpenRecordset("serial")
Dim Idate As Date
Dim Itodo As String
Idate = Me.IssuedDate.Value
Itodo = Me.IssuedToDO.Value
Dim issueqry As String
issueqry = "UPDATE serial " _
& " set serial.IssueToDO = '" & Itodo & "'" _
& " serial.issuedate = (#" & Format(Idate, "mm\/dd\/yyyy") & "#)" _
& " WHERE (((serial.id) Between 1 And 10)) "
DoCmd.RunSQL issueqry
MsgBox ("Issued Done")
End Sub
When you update more than one field, you must include a comma between the field expressions like this ...
SET [field name] = "foo", [another field] = 17
^
here
So try your code like this ...
issueqry = "UPDATE serial " _
& " set serial.IssueToDO = '" & Itodo & "'," _
& " serial.issuedate = #" & Format(Idate, "mm/dd/yyyy") & "#" _
& " WHERE serial.id Between 1 And 10"
Also give yourself an opportunity to inspect the string the code built ...
Debug.Print issueqry
You can view the output from Debug.Print in the Immediate window. Ctrl+g will take you there.
I have a combo box on my form with the choice of choosing organization 10, 20, 30....
I have added ALL to the combo list box, but am having trouble implementing an all statement in VBA. Below is the case statement I have to get info from organizations 10, 20, 30. How do I get ALL to generate??
Case Is = 1
If cboOrg.ListIndex < 0 Then
Call msg("Please select your organization!")
Exit Sub
End If
sQ = sQ & " CC LIKE '" & cboOrg.Value & "*'"
ORGCC = Trim(cboOrg.Value)
I think you should only generate the WHERE/AND-clause, when value is not "ALL" (instead of your current assignment):
If (cboOrg.Value <> "ALL") Then
sQ = sQ & " AND CC LIKE '" & cboOrg.Value & "*'"
End If
To make it work without changing code before (generating AND or WHERE), you could try:
If (cboOrg.Value <> "ALL") Then
sQ = sQ & " CC LIKE '" & cboOrg.Value & "*'"
Else
sQ = sQ & " 1=1"
End If
Do you really need the LIKE (does CC only start with the value selected) or would
WHERE CC = '" & cboOrg.Value & "'" be sufficient?
Private Sub cmdGo_Click()
Dim db As Database, rs As Recordset, sQ As String
Dim oXL, oExcel As Object
Set oXL = CreateObject("Excel.Application")
fPath = "\\firework\mmcfin\123files\Edmond\Lawson Query\Log\"
myTime = Now()
myFile = Environ("UserName") & "-" & Environ("ComputerName") & "-" & Replace(Replace(Replace(Trim(myTime), "/", "-"), " ", "-"), ":", "-")
pTitle = "Lawson Queries"
Set db = CurrentDb
Select Case cboActBud.ListIndex
Case Is < 0
Call msg("Please select your query type first: Actual or Budget!")
Exit Sub
Case Is = 0
sQ = "SELECT * INTO [" & myFile & "] FROM ACT"
toAdd = "WHERE"
Case Is = 1
sQ = "SELECT * INTO [" & myFile & "] FROM BUD"
If cboBucket.ListIndex < 0 Then
Call msg("Please select your budget bucket!")
Exit Sub
Else
toAdd = "WHERE BUDGET_NBR = " & cboBucket.Value & " AND"
End If
End Select
myAcctLo = txtACCT1.Value
myAcctHi = txtACCT2.Value
If IsNull(myAcctLo) Or myAcctLo < 1000 Or myAcctLo > 99999 Then
Call msg("Account number is missing or invalid!")
Exit Sub
End If
If IsNull(myAcctHi) Then
myAcctHi = myAcctLo
End If
If myAcctLo > myAcctHi Then
Call msg("Account range is invalid!")
Exit Sub
End If
If myAcctLo < 90000 And myAcctHi >= 90000 Then
Call msg("You can query amounts or units; but, not both at the same time!")
Exit Sub
End If
Select Case myAcctLo
Case Is < 90000: sQ = sQ & "AMT " & toAdd
Case Is >= 90000: sQ = sQ & "UNT " & toAdd
End Select
Select Case cboLevel.ListIndex
Case Is < 0
Call msg("Please select your reporting level: Cost Center or Organization!")
Exit Sub
Case Is = 0
If IsNull(txtCC) Then
Call msg("Please enter your cost center!")
Exit Sub
End If
sQ = sQ & " CC = " & txtCC.Value
ORGCC = Trim(txtCC.Value)
Case Is = 1
If cboOrg.ListIndex < 0 Then
Call msg("Please select your organization!")
Exit Sub
End If
sQ = sQ & " CC LIKE '" & cboOrg.Value & "*'"
ORGCC = Trim(cboOrg.Value)
If (cboOrg.Value <> "All") Then
sQ = sQ & " CC LIKE '" & cboOrg.Value & "*'"
Else
sQ = sQ & " 1=1"
End If
End Select
If cboYear.ListIndex < 0 Then
Call msg("Please select an year!")
Exit Sub
End If
sQ = sQ & " AND FY = " & cboYear.Value & " AND (ACCT >= " & myAcctLo & " AND ACCT <= " & myAcctHi & ")"
DoCmd.Hourglass True
db.Execute sQ
sQ = "INSERT INTO tblLog (UserName, ComputerName, DateAndTime, ORGORCC, ACCT1, ACCT2, BUDGET, FY) VALUES ('" & _
Environ("UserName") & "','" & Environ("ComputerName") & "',#" & myTime & "#," & ORGCC & "," & myAcctLo & _
"," & myAcctHi & "," & IIf(cboBucket.ListIndex < 0, 0, Trim(cboBucket.Value)) & "," & Trim(cboYear.Value) & ")"
db.Execute sQ
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, myFile, fPath & myFile, True
With oXL
.Visible = True
.Workbooks.Open (fPath & myFile)
End With
Set oXL = Nothing
DoCmd.Hourglass False
db.Close