VBA - Get all value in Array as subsequent strings - sql

I have connected VBA & SQL Database in order to pull information.
I have written a script that returns exactly what I want but I would like to make it dynamical (Change years used etc.) and I am here running into problems.
I need to have a special line in my SQL Query which only has 1 thing that changes between the lines (Number of lines need to change and the Case when y.Date_Year = )
I get an Error message in the below code saying that there is a Type mismatch at the " & " sign right above my "period ()" array.
Sub test()
Dim SQLDB As ADODB.Connection
Dim sQuery As String
Dim info()
Dim Start_D As String
Dim End_D As String
Dim Numerator_Used As String
Dim Denominator_Used As String
Dim Number_Years As Integer
Dim period()
Numerator_Used = Range("Numerator")
Denominator_Used = Range("Denominator")
Start_D = Range("Start_Date")
End_D = Range("End_Date")
Range("A11:J100000").Cells.ClearContents
Number_Years = End_D - Start_D
ReDim period(Number_Years + 1)
For i = 0 To Number_Years
period(i + 1) = ",sum(case when y.date_year = " & Start_D + i & " then n." & Numerator_Used & " end) / sum(case when y.date_year = " & Start_D + i & " then s." & Denominator_Used & " end) as '" & Numerator_Used & "/" & Denominator_Used & " " & Start_D + i & "' & _ "
Next i
' Get Margin Expectation Changes
sQuery ="select m.date_month" & _
" m.date_month " & _
period() & _
" from " & Numerator_Used & " as n" & _
" inner join " & Denominator_Used & " as s on s.company_id = n.company_id" & _
" and s.date_month_id = n.date_month_id" & _
" and s.date_year_id = n.date_year_id" & _
" inner join date_year as y on y.date_year_id = n.date_year_id" & _
" inner join date_month as m on m.date_month_id = n.date_month_id" & _
" where y.date_year between " & Start_D & " and " & End_D & " " & _
" and n." & Numerator_Used & " <> 0" & _
" and s." & Denominator_Used & " <> 0" & _
" group by m.date_month;"
Set rs = Common.SQL_Read(SQLDB, sQuery)
ThisWorkbook.Worksheets("Sheet1").Range("A11").CopyFromRecordset rs
Set SQLDB = Common.SQL_Close(SQLDB)
End Sub

As i mentioned in the ocmment to the question, you can not explicity convert period() data into string as it is an array of variant data type (each undefined variable is treated as variant data type). You have to loop through the array data, i.e.:
For i = LBound(period()) To UBound(period())
sQuery = sQuery & period(i) & "...."
Next
'finally:
sQuery = "SELECT ... " & sQuery & " ...."
Change the code as i mentioned above and let me know if it works.

Related

Dynamically run strings in a loop

I want to run a string dynamically.
I'm trying to run a VBA loop to build a SQL Union for each record after the first. There could be anywhere from 1 record to 100. I want this to be dynamic so I don't have to limit the number of entries.
Example:
If I have 5 records it creates the SQL query with 4 unions. All the same data etc.
I'm trying to do is this:
When someone opens a form they will enter a list of pack numbers, from that they will select the range of offers under each pack number (All Offers, Promo, or Buyer).
The code then builds a union query for each pack number based on the the offer range they selected.
The output is all the data on those Offers under that pack number.
My full code: (I thought it necessary to get the full picture)
Private Sub ReviewButton_Click()
Dim Owner As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdfPassThrough As QueryDef
Dim strSeasonSQL As String
Dim strSeason As String
Dim strType As String
Owner = GetNamespace("MAPI").Session.CurrentUser.AddressEntry
If Me.NewRecord = True Then
Me!Owner.Value = Owner
End If
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
'Set rs = CurrentDb.OpenRecordset("SELECT * FROM RetailEntry")
strSeason = [Forms]![Retail_Navigation]![NavigationSubform].[Form]![cboSeason]
strType = rs.Fields("Offer").Value '[Forms]![ReviewButton]![RetailEntry].[Form]![Offer].Value
On Error GoTo 1
1:
'Build Initial Query based on first record and make sure there are records
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
StrSQL = "Set NoCount ON DROP TABLE #catcov; " _
& "SELECT DISTINCT mailyear, offer, description, firstreleasemailed, season_id, offer_type, " _
& "case when description like '%Promo%' then 'Promo' " _
& "Else 'Buyer' end As addtype " _
& "INTO #catcov " _
strSELECT = "FROM supplychain_misc.dbo.catcov; " _
& "SELECT DISTINCT " _
& "a.PackNum " _
& ",a.Description " _
& ",a.CatID " _
& ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
& ",a.RetOne " _
& ",a.Ret2 " _
& ",a.ORIGINALRETAIL " _
& ",a.DiscountReasonCode " _
& ",b.Season_id " _
& ",a.year " _
& ",addtype "
strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
strWHERE = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
& " and b.Season_id = '" & strSeason & "' " _
& " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "
StrSQL = StrSQL & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE
'Promo/Core
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
StrSQL = "Set NoCount ON DROP TABLE #catcov; " _
& "SELECT DISTINCT mailyear, offer, description, firstreleasemailed, season_id, offer_type, " _
& "case when description like '%Promo%' then 'Promo' " _
& "Else 'Buyer' end As addtype " _
& "INTO #catcov " _
strSELECT = "FROM supplychain_misc.dbo.catcov; " _
& "SELECT DISTINCT " _
& "a.PackNum " _
& ",a.Description " _
& ",a.CatID " _
& ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
& ",a.RetOne " _
& ",a.Ret2 " _
& ",a.ORIGINALRETAIL " _
& ",a.DiscountReasonCode " _
& ",b.Season_id " _
& ",a.year " _
& ",addtype "
strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
strWHERE = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
& " and b.Season_id = '" & strSeason & "' and b.addtype = '" & strType & "' " _
& " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "
StrSQL = StrSQL & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE
End If
'Build/Loop Unions for each record after the first
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs.MoveNext
strType = rs.Fields("Offer").Value
Do Until rs.EOF = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
StrUnion = "UNION SELECT DISTINCT " _
& "a.PackNum " _
& ",a.Description " _
& ",a.CatID " _
& ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
& ",a.RetOne " _
& ",a.Ret2 " _
& ",a.ORIGINALRETAIL " _
& ",a.DiscountReasonCode " _
& ",b.Season_id " _
& ",a.year " _
& ",addtype "
strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
strWHEREnxt = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
& " and b.Season_id = '" & strSeason & "' " _
& " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "
StrSQL2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt
'Promo/Buyer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
StrUnion = "UNION SELECT DISTINCT " _
& "a.PackNum " _
& ",a.Description " _
& ",a.CatID " _
& ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
& ",a.RetOne " _
& ",a.Ret2 " _
& ",a.ORIGINALRETAIL " _
& ",a.DiscountReasonCode " _
& ",b.Season_id " _
& ",a.year " _
& ",addtype "
strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
strWHEREnxt = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
& " and b.Season_id = '" & strSeason & "' and b.addtype = '" & strType & "' " _
& " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "
StrSQL2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt
End If
'Move to next Record and loop till EOF
rs.MoveNext
Loop
'If there are no Records then error
Else
MsgBox "There are no Pack Numbers Entered."
End If
'END QUERY
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Build Retail Bump File Pass Through Query
db.QueryDefs.Delete "qryMaster"
Set qdfPassThrough = db.CreateQueryDef("qryMaster")
qdfPassThrough.Connect = "ODBC;DSN=SupplyChainMisc;Description=SupplyChainMisc;Trusted_Connection=Yes;DATABASE=SupplyChain_Misc;"
qdfPassThrough.ReturnsRecords = True
qdfPassThrough.sql = StrSQL & vbCrLf & StrSQL2
rs.Close
Set rs = Nothing
DoCmd.OpenForm "SubCanButton"
DoCmd.OpenQuery "MasterQuery"
DoCmd.Close acForm, "ReviewButton"
End Sub
First, you do a "union distinct" when you don't include ALL:
UNION ALL
SELECT DISTINCT ...
Thus, as your selected records seem the same, only one will returned.
Second, including ALL or not, your concept doesn't make much sense. Why union a lot of identical records? Even if they hold different IDs only, they seem to be pulled from the same table, which you could with a single query.
Third, casting a date value to a date value does nothing good, so:
cast(dateadd(day, +21, getdate()) as date)
can be reduced to:
dateadd(day, +21, getdate())

Update SQL in Access VBA -- Updating Table Values From Another Table

I'm fairly new to Access VBA and SQL coding. So far, I've been able to find most of the answers to issues I've had by using the internet. I'm currently trying to write some code in MS Access (2013) VBA that updates the data in one table from another table in the same database when a particular form closes.
I've worked out several errors so far, but I'm stuck on a syntax error in the "UPDATE" for SQLReplace. There could be other errors that I don't know about yet, but I'm not sure. Any help/Guidance would be greatly appreciated!
Thanks!
Private Sub Form_Close()
Dim SQLMove As String
Dim SQLReplace As String
Dim CountyCaseType As String
Dim CaseNumber As String
Dim County As String
Dim FirstName As String
Dim MiddleName As String
Dim LastName As String
Dim Facility As String
Dim VOL As String
Dim Diagnosis As String
Dim AppearanceWaived As String
Dim Dismissed As String
Dim HearingResults As String
Dim Disposition As String
Dim DOB As String
Dim Minor As String
Dim Sex As String
Dim ClerkName As String
Dim Judge As String
Dim CourtDate As String
CountyCaseType = "Tables!tblTemp.CountyCaseType.Value"
CaseNumber = "Tables!tblTemp.CaseNumber.Value"
County = "Tables!tblTemp.County.Value"
FirstName = "Tables!tblTemp.FirstName.Value"
MiddleName = "Tables!tblTemp.MiddleName.Value"
LastName = "Tables!tblTemp.LastName.Value"
Facility = "Tables!tblTemp.Facility.Value"
VOL = "Tables!tblTemp.VOL.Value"
Diagnosis = "Tables!tblTemp.Diagnosis.Value"
AppearanceWaived = "Tables!tblTemp.AppearanceWaived.Value"
Dismissed = "Tables!tblTemp.Dismissed.Value"
HearingResults = "Tables!tblTemp.HearingResults.Value"
Disposition = "Tables!tblTemp.Disposition.Value"
DOB = "Tables!tblTemp.DOB.Value"
Minor = "Tables!tblTemp.Minor.Value"
Sex = "Tables!tblTemp.Sex.Value"
ClerkName = "Tables!tblTemp.Clerk.Value"
Judge = "Tables!tblTemp.Judge.Value"
CourtDate = "Tables!tblTemp.CourtDate.Value"
SQLMove = "INSERT INTO tblCalendar SELECT * FROM tblTemp"
SQLReplace = "UPDATE tblCalendar " & _
"SET tblCalendar.CountyCaseType.Value = CountyCaseType, " & _
" tblCalendar.CaseNumber.Value = CaseNumber, " & _
" tblCalendar.County.Value = County, " & _
" tblCalendar.FirstName.Value = FirstName, " & _
" tblCalendar.MiddleName.Value = MiddleName, " & _
" tblCalendar.LastName.Value = LastName, " & _
" tblCalendar.Facility.Value = Facility, " & _
" tblCalendar.VOL.Value = VOL, " & _
" tblCalendar.Diagnosis.Value = Diagnosis, " & _
" tblCalendar.AppearanceWaived.Value = AppearanceWaived, " & _
" tblCalendar.Dismissed.Value = Dismissed, " & _
" tblCalendar.HearingResults.Value = HearingResults, " & _
" tblCalendar.Disposition.Value = Disposition, " & _
" tblCalendar.DOB.Value = DOB, " & _
" tblCalendar.Minor.Value = Minor, " & _
" tblCalendar.Sex.Value = Sex, " & _
" tblCalendar.ClerkName.Value = Clerk, " & _
" tblCalendar.Judge.Value = Judge, " & _
"FROM tblTemp " & _
"Where 'CourtDate = tblCalendar.CourtDate.Value'"
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLMove)
DoCmd.RunSQL (SQLReplace)
DoCmd.SetWarnings True
End Sub
There are several potential errors in your code:
You do not need to add .Value to the end of an attribute to get its actual value.
As you are working directly in Access, you to not need the Tables! part either. That is the syntax used when dealing with recordsets. For example, write tblTemp.CountyCaseType instead of Tables!tblTemp.CountyCaseType.Value
The values of your variables are not in the SQL string. You have to concatenate them to the SQLReplace String using [&]. For example, write
SQLReplace = "UPDATE tblCalendar " & _
"SET tblCalendar.CountyCaseType = " & CountyCaseType & ", " & _
" tblCalendar.CaseNumber = " & CaseNumber & ", " & _
....
As #AlanHadsell pointed out, remove the single quotes from the WHERE clause.
Where 'CourtDate = tblCalendar.CourtDate.Value'
should be
WHERE CourtDate = tblCalendar.CourtDate
But as I said in 3) CourTDate is a String variable, so it needs to be concatenated. Your final WHERE clause should be:
"WHERE " & CourtDate & " = tblCalendar.CourtDate"
You don't need the FROM tblTemp clause in the SQLReplace String.
EDIT: As #Parfait pointed out, tblTemp does not exist in scope of the SQLReplace statement. You should do an INNER JOIN to fix that:
UPDATE tblCalendar INNER JOIN tblTemp ON tblCalendar.CourtDate = tblTemp.CourtDate SET ...
After fixing everything, your final code should look like:
Private Sub Form_Close()
Dim SQLMove As String
Dim SQLReplace As String
Dim CountyCaseType As String
Dim CaseNumber As String
Dim County As String
Dim FirstName As String
Dim MiddleName As String
Dim LastName As String
Dim Facility As String
Dim VOL As String
Dim Diagnosis As String
Dim AppearanceWaived As String
Dim Dismissed As String
Dim HearingResults As String
Dim Disposition As String
Dim DOB As String
Dim Minor As String
Dim Sex As String
Dim ClerkName As String
Dim Judge As String
Dim CourtDate As String
CountyCaseType = "tblTemp.CountyCaseType"
CaseNumber = "tblTemp.CaseNumber"
County = "tblTemp.County"
FirstName = "tblTemp.FirstName"
MiddleName = "tblTemp.MiddleName"
LastName = "tblTemp.LastName"
Facility = "tblTemp.Facility"
VOL = "tblTemp.VOL"
Diagnosis = "tblTemp.Diagnosis"
AppearanceWaived = "tblTemp.AppearanceWaived"
Dismissed = "tblTemp.Dismissed"
HearingResults = "tblTemp.HearingResults"
Disposition = "tblTemp.Disposition"
DOB = "tblTemp.DOB"
Minor = "tblTemp.Minor"
Sex = "tblTemp.Sex"
ClerkName = "tblTemp.Clerk"
Judge = "tblTemp.Judge"
CourtDate = "tblTemp.CourtDate"
SQLMove = "INSERT INTO tblCalendar SELECT * FROM tblTemp"
SQLReplace = "UPDATE tblCalendar " & _
"INNER JOIN tblTemp ON tblCalendar.CourtDate = tblTemp.CourtDate " & _
"SET tblCalendar.CountyCaseType = " & CountyCaseType & ", " & _
" tblCalendar.CaseNumber = " & CaseNumber & ", " & _
" tblCalendar.County = " & County & ", " & _
" tblCalendar.FirstName = " & FirstName & ", " & _
" tblCalendar.MiddleName = " & MiddleName & ", " & _
" tblCalendar.LastName = " & LastName & ", " & _
" tblCalendar.Facility = " & Facility & ", " & _
" tblCalendar.VOL = " & VOL & ", " & _
" tblCalendar.Diagnosis = " & Diagnosis & ", " & _
" tblCalendar.AppearanceWaived = " & AppearanceWaived & ", " & _
" tblCalendar.Dismissed = " & Dismissed & ", " & _
" tblCalendar.HearingResults = " & HearingResults & ", " & _
" tblCalendar.Disposition = " & Disposition & ", " & _
" tblCalendar.DOB = " & DOB & ", " & _
" tblCalendar.Minor = " & Minor & ", " & _
" tblCalendar.Sex = " & Sex & ", " & _
" tblCalendar.ClerkName = " & Clerk & ", " & _
" tblCalendar.Judge = " & Judge
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLMove)
DoCmd.RunSQL (SQLReplace)
DoCmd.SetWarnings True
End Sub
To finish, instead of declaring a String variable for each attributes in tableTemp that you want to copy, and then assigning some values to them, you can simply omit the declarations and put the attributes dicrectly in the SQL. That will geatly reduce the length of your code as follow:
Private Sub Form_Close()
Dim SQLMove As String
Dim SQLReplace As String
SQLMove = "INSERT INTO tblCalendar SELECT * FROM tblTemp"
SQLReplace = "UPDATE tblCalendar " & _
"INNER JOIN tblTemp ON tblCalendar.CourtDate = tblTemp.CourtDate " & _
"SET tblCalendar.CountyCaseType = tblTemp.CountyCaseType, " & _
" tblCalendar.CaseNumber = tblTemp.CaseNumber, " & _
" tblCalendar.County = tblTemp.County, " & _
" tblCalendar.FirstName = tblTemp.FirstName, " & _
" tblCalendar.MiddleName = tblTemp.MiddleName, " & _
" tblCalendar.LastName = tblTemp.LastName, " & _
" tblCalendar.Facility = tblTemp.Facility, " & _
" tblCalendar.VOL = tblTemp.VOL, " & _
" tblCalendar.Diagnosis = tblTemp.Diagnosis, " & _
" tblCalendar.AppearanceWaived = tblTemp.AppearanceWaived, " & _
" tblCalendar.Dismissed = tblTemp.Dismissed, " & _
" tblCalendar.HearingResults = tblTemp.HearingResults, " & _
" tblCalendar.Disposition = tblTemp.Disposition, " & _
" tblCalendar.DOB = tblTemp.DOB, " & _
" tblCalendar.Minor = tblTemp.Minor, " & _
" tblCalendar.Sex = tblTemp.Sex, " & _
" tblCalendar.ClerkName = tblTemp.ClerkName, " & _
" tblCalendar.Judge = tblTemp.Judge"
DoCmd.SetWarnings False
DoCmd.RunSQL (SQLMove)
DoCmd.RunSQL (SQLReplace)
DoCmd.SetWarnings True
End Sub
Remove the single quotes from "Where 'CourtDate = tblCalendar.CourtDate.Value'"

Error 3075 When breaking down long text for update query

The Description field is a long text field with over 255 characters. so I'm trying to break it down before I update it. My error reads:
Run-Time error '3075 Syntax error (missing Operator) in query
expression "titlename'Set Description = '([prm_val1] &
[prm_val2].....[prm_val7])".
Here's my code:
l = Len(Me.Description)
If l Mod 255 = 0 Then 'For length exactly a multiple of 255 (255, 510, 765...)
n = l / 255
Else
n = Int(l / 255) + 1
End If
sp = "[prm_val1]"
If n > 1 Then 'If >255 chars tap on concatenated parameters as needed
For p = 2 To n
sp = sp & " & [prm_val" & p & "]"
Next p
End If
'UpdateDescription = "UPDATE AllProjects " & _
'"Set Description='" & sp & "'" & _
'" WHERE ID =" & Me.ID
'CurrentDb.Execute UpdateDescription
'For p = 1 To n 'Add each 255 char piece as the parameters
'qdf.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
'Next p
'qdf.Execute
DoCmd.SetWarnings False
strSQL = "UPDATE AllProjects " & _
"Set Title='" & Me.Title & "'" & _
"Set Description='(" & sp & ")'" & _
",Department='" & Me.Department & "'" & _
",Priority='" & Me.Priority & "'" & _
",Status='" & Me.Status & "'" & _
",[Create Date]='" & Me.CreateDate & "'" & _
",[% Complete]='" & Me.PerComplete & "'" & _
",[File Location]='" & Me.FileLocation & "'" & _
",[Update Notes]='" & Me.UpdateNotes & "'" & _
",Leader='" & Me.Leader & "'" & _
",[Target Date]='" & Me.TargetDate & "'" & _
",[Complete Date]='" & Me.CompleteDate & "'" & _
",Category='" & Me.Category & "'" & _
",Feedback='" & Me.Feedback & "'" & _
",[File Location 2]='" & Me.FileLocation2 & "'" & _
",[File Location 3]='" & Me.FileLocation3 & "'" & _
",[Strategic Initiatives]='" & Me.StrategicInitiatives & "'" & _
" WHERE ID =" & Me.ID
CurrentDb.Execute strSQL
For p = 1 To n 'Add each 255 char piece as the parameters
strSQL.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
Next p
DoCmd.SetWarnings True
This code is called after the execute, and does not make any sense:
For p = 1 To n 'Add each 255 char piece as the parameters
strSQL.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
Next p
as strSQL doesn't take parameters.
Adjust this code and move it inte the code before calling execute.
Or use the query you have commented out.

access 2013 increasing quantity in a table field

Good day. I'm a little stumped about what is happening in my code. I have a userform which collects txtQntyRecd and cboSupplySource. I calculate the lookupValue. And it works just fine. It successfully places the txtQntyRecd in the correct tblWarehouseLocations.WQuantity location. The code is:
updateQnty = "UPDATE tblSupplySources INNER JOIN ((tblWarehouseLocations " & _
"INNER JOIN tblSupplySource_WarehouseLocation ON tblWarehouseLocations.WLocation_ID = tblSupplySource_WarehouseLocation.SWLocation_ID)) " & _
"ON tblSupplySources.SupplySourceID = tblSupplySource_WarehouseLocation.Supply_Source_ID " & _
"SET tblWarehouseLocations.WQuantity = '" & Me.txtQntyRecd & "'" & _
"WHERE (((tblSupplySource_WarehouseLocation.Supply_Source_ID)= " & Me.cboSupplySource & ") " & _
" AND ((tblWarehouseLocations.WLocation_ID)=" & lookupValue & "))"
CurrentDb.Execute updateQnty, dbFailOnError
What I want to do is add the next quantity to the same location. I get weird results if I change the SET statement to the following:
SET tblWarehouseLocations.WQuantity = tblWarehouseLocations.WQuantity + '" & Me.txtQntyRecd & "'"
If I put 200 in the first statement, I get 200 in my WQuantity field. When I change to the second statement and I try to add 1 to the 200 I get a result of 211. If I add 1 again, the result is 223. Add 1 again, the result is 236.
Could someone explain what is happening and why the results aren't 201, 202 and 203? In the future I will need to subtract quantities from WQuantity as well.
Thanks
You're adding quotes around an integer and appending it as a string. Change it to:
".....
SET tblWarehouseLocations.WQuantity = tblWarehouseLocations.WQuantity + " & val(Me!txtQntyRecd) & "....
...."
I've changed the . to a ! as I think it's still a nice distinction between objects properties and controls, and used the val function as it converts the string number value to the integer value.
This is your query in full:
' When I use values from controls, I like to store them in vars
Dim quantityReceived As integer
quantityReceived = val(Me!txtQntyRecd)
updateQnty = "UPDATE tblSupplySources INNER JOIN ((tblWarehouseLocations " & _
"INNER JOIN tblSupplySource_WarehouseLocation ON tblWarehouseLocations.WLocation_ID = tblSupplySource_WarehouseLocation.SWLocation_ID)) " & _
"ON tblSupplySources.SupplySourceID = tblSupplySource_WarehouseLocation.Supply_Source_ID " & _
"SET tblWarehouseLocations.WQuantity = tblWarehouseLocations.WQuantity + " & quantityReceived & _
" WHERE (((tblSupplySource_WarehouseLocation.Supply_Source_ID)= " & Me.cboSupplySource & ") " & _
" AND ((tblWarehouseLocations.WLocation_ID)=" & lookupValue & "))"
I solved the problem. I created a SELECT query to get the present amount in WQuantity. Now quantityReceived = Me!txtQntyRecd + the present amount. With SET tblWarehouseLocations.WQuantity = " & quantityReceived it works fine. However, if just seems so cumbersome.
' lookupValue gives the index into the tblWarehouseLocations where WQuantity resides
Dim lookupValue As Integer
lookupValue = DLookup("[WLocation_ID]", "[tblWarehouseLocations]", "[Location_Name] = '" & Me.cboWLocation & "'")
'Define SQL Query
strSQL = "select tblWarehouseLocations.WQuantity FROM tblWarehouseLocations WHERE (((tblWarehouseLocations.WLocation_ID)= " & lookupValue & "))"
Set rs = db.OpenRecordset(strSQL)
If IsNull(rs!WQuantity) Then
dbvalue = 0
Else
dbvalue = rs!WQuantity
End If
Dim quantityReceived As Integer
quantityReceived = Val(Me!txtQntyRecd) + dbvalue
updateQnty = "UPDATE tblSupplySources INNER JOIN ((tblWarehouseLocations " & _
"INNER JOIN tblSupplySource_WarehouseLocation ON tblWarehouseLocations.WLocation_ID = tblSupplySource_WarehouseLocation.SWLocation_ID)) " & _
"ON tblSupplySources.SupplySourceID = tblSupplySource_WarehouseLocation.Supply_Source_ID " & _
"SET tblWarehouseLocations.WQuantity = " & quantityReceived & _
" WHERE (((tblSupplySource_WarehouseLocation.Supply_Source_ID)= " & Me.cboSupplySource & ") " & _
" AND ((tblWarehouseLocations.WLocation_ID)=" & lookupValue & "))"
CurrentDb.Execute updateQnty, dbFailOnError

How to create percentile function for a SQL query in MS Access that allows GROUP BY and filtering?

I'm attempting to write a domain function I can use in MS Access SQL view like what is found here: DMedian in access 2013, no values returned
...but for a DPercentile function that allows you to GROUP BY and filter.
This is what I have so far:
Public Function DPercentileWithGrpBy( _
ByVal sFld As String, _
ByVal sTable As String, _
ByVal iPercent As Integer, _
ByVal sGrpByFld As String, _
ByVal sGrpByValue As String _
) As Variant
Dim db As DAO.Database
Dim rstDomain As DAO.Recordset
Dim sSQL As String
Const errAppTypeError = 3169
On Error GoTo HandleErr
Set db = CurrentDb()
' Build SQL string for recordset.
sSQL = "SELECT " & _
sTable & "." & sGrpByFld & _
"," & (1 - iPercent / 100) & "*(" & _
"SELECT Max(" & sFld & ") " & _
"FROM " & sTable & " " & _
"WHERE " & sTable & "." & sFld & " IN (" & _
"SELECT TOP " & iPercent & " PERCENT " & sFld & " " & _
"FROM " & sTable & " " & _
"WHERE " & sTable & "." & sGrpByFld & " = " & Chr(34) & sGrpByValue & Chr(34) & " AND " & sFld & " Is Not Null ORDER BY " & sFld & ")) + " & iPercent / 100 & "*(" & _
"SELECT Min(" & sFld & ") " & _
"FROM " & sTable & " " & _
"WHERE " & sTable & "." & sFld & " IN (" & _
"SELECT TOP " & 100 - iPercent & " PERCENT " & sFld & " " & _
"FROM " & sTable & " " & _
"WHERE " & sTable & "." & sGrpByFld & " = " & Chr(34) & sGrpByValue & Chr(34) & " AND " & sFld & " Is Not Null ORDER BY " & sFld & " DESC)" & _
") AS " & iPercent & "Percentile " & _
"FROM " & sTable & " " & _
"WHERE " & sTable & "." & sGrpByFld & " = " & Chr(34) & sGrpByValue & Chr(34) & " " & _
"GROUP BY " & sTable & "." & sGrpByFld & ";"
'Debug.Print sSQL
'above should result in something like this:
'SELECT
' tblFirst250.[GICS Sector]
' , 0.75*(
' SELECT Max(GM)
' FROM tblFirst250
' WHERE tblFirst250.GM IN (
' SELECT TOP 25 PERCENT GM
' FROM tblFirst250
' WHERE tblFirst250.[GICS Sector] = "Energy" AND GM Is Not Null ORDER BY GM)) + 0.25*(
' SELECT Min(GM)
' FROM tblFirst250
' WHERE tblFirst250.GM IN (
' SELECT TOP 75 PERCENT GM
' FROM tblFirst250
' WHERE tblFirst250.[GICS Sector] = "Energy" AND GM Is Not Null ORDER BY GM DESC)
' ) AS 25Percentile
'FROM tblFirst250
'WHERE tblFirst250.[GICS Sector] = "Energy"
'GROUP BY tblFirst250.[GICS Sector];
Set rstDomain = db.OpenRecordset(sSQL, dbOpenDynaset)
DPercentileWithGrpBy = rstDomain
ExitHere:
On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
Exit Function
HandleErr:
' Return an error value.
DPercentileWithGrpBy = CVErr(Err.Number)
Resume ExitHere
End Function
I'd like to have the ability to use the function in MS Access SQL View as a query or part of a query. I also need to do a percentile (quartiles) of a sub group of records. Hopefully that make sense...
EDIT: the resulting query works when I debug.print it and using it in SQL View.
EDIT: here is how you could use it:
DPercentileWithGrpBy( "GM","tblFirst250", 25,"[GICS Sector]","Energy")