I have an Excel workbook with two dynamic OLE DB queries. I'm having issues with refreshes.
To set things up I have a SQL table-valued function as the source. The data is of the nature of...
SGrp SG_Desc SKU SKU_Desc Server Billed
1 Item 1 111 whatever 15 12
1 Item 2 222 some more 10 9
2 Item 3 333 zzz 10 8
3 Item 4 555 abc 20 18
On the first sheet ("Overall") I have a data connection that summarizes the groups with the command text of dynamically modified with one button.
SELECT SGrp, SG_Desc, SUM(Served) AS Served, SUM(Billed) AS Billed FROM mySQLdb ('8/19/2018','8/25/2018') WHERE SGrp <> '' GROUP BY SGrp, SG_Desc ORDER BY SG_Desc
I then have a cell with a data validation list that selects the group and a button to execute the VBA to dynamically modify the other connection. There's also two cells with the report start & end date for filtering. When I push the "Detail" button it runs the code below.
Private Sub RunDetail_Click()
Dim StartDate As Date
Dim EndDate As Date
Dim SGrp As String
Range("A1").Value = Range("G8").Value2
StartDate = Sheets("Overall").Range("H1").Value
EndDate = Sheets("Overall").Range("H2").Value
SGrp = Sheets("Overall").Range("A1").Value
SGrp = LTrim(RTrim(SGrp))
With ActiveWorkbook.Connections("CJP_DeliveryRecap_Detail").OLEDBConnection
.CommandText = "SELECT SKU, SKU_Desc, Served, Billed FROM mySQLdb ('" & StartDate & "','" & EndDate & "') WHERE SG_Desc='" & SGrp & "'"
' .Refresh
' ActiveWorkbook.Connections("CJP_DeliveryRecap_Detail").Refresh
End With
'RefreshOLEDB
'ThisWorkbook.RefreshAll
ActiveWorkbook.Connections("CJP_DeliveryRecap_Detail").Refresh
'Application.CalculateUntilAsyncQueriesDone
Application.Wait (Now + TimeValue("0:00:03"))
Dim rc As Integer
Dim i As Integer
Worksheets("Detail").Activate
With Worksheets("Detail").Range("CJP_DeliveryRecap_Detail")
rc = .Rows.Count
End With
With Worksheets("Detail").Range("E1048576")
.Select
.End(xlUp).Select
End With
i = Selection.Row
Worksheets("Detail").Range("E5").Select
Worksheets("Detail").Range("E5:G" & i).ClearContents
Worksheets("Detail").Range("E5").Value = 1
Worksheets("Detail").Range("F5").Value = "=+CJP_DeliveryRecap_Detail[#Served]*E5"
Worksheets("Detail").Range("G5").Value = "=+CJP_DeliveryRecap_Detail[#Billed]*E5"
Sheets("Detail").Range("E5:G5").Copy Sheets("Detail").Range("E6:E" & rc + 4)
Sheets("Detail").Range("F1").Value = ("=SUM(F5:F" & rc + 4 & ")")
Sheets("Detail").Range("G1").Value = ("=SUM(G5:G" & rc + 4 & ")")
End Sub
So, what is it doing? The first "strange" thing is I occasionally get errors in the code that I have to continue on. A lot of times, but not all, it hits the Application.Wait line, then the Worksheets("Detail").Activate line, and sometimes the line where I set values or copy data.
There are some comments where I've been testing various refreshes etc. The issue is because while when the code completes it displays the data conn detail correctly but the calculations as to the size of the results is from the prior set. If I click the button a second time then it calculates them correctly. I would of course prefer not to have a arbitrary 3sec delay but simply run the rest of the code after the resultant records have been retrieved.
Where am I going wrong as I've been banging my head against the wall with this. Most of what I do is in Access but Excel was the proper tool in this case.
I just thought of, but not thrilled to, would it work to have a separate sub to handle the record size calcs and cell values clear\set and call that from the button click or would that still not be generated until after the original sub ends.
Thanks in advance,
You need to wait till query is complete before proceeding with calculations.
What you need is to add .BackgroundQuery = False to your connection before .refresh
With ActiveWorkbook.Connections("CJP_DeliveryRecap_Detail").OLEDBConnection
.BackgroundQuery = False
.CommandText = "SELECT SKU, SKU_Desc, Served, Billed FROM mySQLdb ......"
.Refresh
End With
This should help
If the stored procedure being called from Excel does not contain "SET NOCOUNT ON" it will not run properly from Excel. I had the same issue and SET NOCOUNT ON was not included in my stored proc; the second i added it, it worked!
Related
I have delete and append functions that build Table1 based on inputs from the user. Therefore Table1 has a different number of records appending to it for every user.
My SQL code works to find the dates, but it only does it once, I need to loop the SQL code for the length of the table. I'm not great at coding, I tried a while statement, not sure if I can use variable Z in the criteria for that, but I want it to run until the due_date in the record with the smallest ID value has been filled.
Here's what I tried:
Private Sub Command7_Click()
Y = DMax("ID", "Table1", BuildCriteria("Due_date", dbDate, "Null"))
A = DMin("ID", "Table1", BuildCriteria("Due_date", dbDate, "Not Null"))
X = DMin("ID", "Table1")
Z = DLookup("Due_date", "Table1", BuildCriteria("ID", dbLong, CStr(X)))
B = DLookup("Duration", "Table1", BuildCriteria("ID", dbLong, CStr(Y)))
C = DLookup("Due_date", "Table1", BuildCriteria("ID", dbLong, CStr(A)))
E = DateAdd("d", -B, C)
Dim SQL As String
SQL = "UPDATE Table1 " & _
"SET " & BuildCriteria("Due_date", dbDate, CStr(E)) & " " & _
"WHERE " & BuildCriteria("ID", dbLong, CStr(Y))
While Z Is Null
DoCmd.RunSQL SQL
End While
End Sub
To illustrate:
Before Running SQL
After running SQL once
After clicking several times
The goal would be to click once and the whole table fills
Your variable Z contains the result returned by the DLookup function when evaluated as the fourth line of the definition of your sub Command7_Click; the value of this variable will not change unless the variable is redefined.
The intent of your code is somewhat obscured by the use of your BuildCriteria function, so it is difficult to advise the best way to write the code...
Edit: BuildCriteria is a new one for me - thanks to #Andre for pointing this out.
Since the content of your SQL statement is static, there should be no need for a loop, as nothing is changing within the loop - the SQL statement will update all records which meet your criteria and will do nothing for every subsequent iteration (unless, that is, the value to which you are updating the records also fulfils the selection criteria).
EDIT
Based on your additional explanations & screenshots, you could approach the task by iterating over a recordset sorted by your ID field and successively calculating the appropriate Due_date for each record - something like:
Private Sub Command7_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim dat As Date
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("select * from Table1 order by ID desc")
With rst
If Not .EOF Then
.MoveFirst
Do Until .EOF
If Not IsNull(!Due_date) Then
dat = !Due_date
Else
dat = DateAdd("d", -!Duration, dat)
.Edit
!Due_date = dat
.Update
End If
.MoveNext
Loop
End If
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End Sub
Though based on your screenshots, it seems that you are trying to use Access like an Excel spreadsheet.
Consider actually no For loop, no BuildCriteria and even no VBA SQL. Save the update query as an MS Access action query object that is run on button click.
Specifically, you would need several domain functions --DLookUp, DSum, and DMax-- where you calculate a running sum of duration days (i.e., a correlated aggregate computation) and then DateAdd the result to the DueDate of the corresponding maximum ID with no missing DueDate.
SQL
UPDATE myTable d
SET d.DueDate = DateAdd("d", -1 * DSum("Duration", "DueDateDuration", "ID >= " & d.ID),
DLookUp("DueDate", "DueDateDuration", "ID = " &
DMax("ID", "DueDateDuration", "DueDate IS NOT NULL")
)
)
WHERE d.DueDate IS NULL;
VBA
Private Sub Command7_Click()
DoCmd.OpenQuery "mySavedUpdateQuery" ' WITH WARNINGS
CurrentDb.Execute "mySavedUpdateQuery" ' WITHOUT WARNINGS
End Sub
To demonstrate on sample data:
Before Update (mytable)
ID Item Duration DueDate
2674 Issue 1 2/18/2019
2675 Shipping 1 2/19/2019
2678 Completed 0 2/20/2019
2679 Issue 1
2680 Shipping 10
2681 Other 6
2682 Buy Off 6
2683 Punch List 3
2684 Completed 0 3/29/2019
After Update (mytable)
ID Item Duration DueDate
2674 Issue 1 2/18/2019
2675 Shipping 1 2/19/2019
2678 Completed 0 2/20/2019
2679 Issue 1 3/3/2019
2680 Shipping 10 3/4/2019
2681 Other 6 3/14/2019
2682 Buy Off 6 3/20/2019
2683 Punch List 3 3/26/2019
2684 Completed 0 3/29/2019
So I am running a Do loop that cycles through a list. I used the 'index' function to calculate the value in the cell. I have a cell that is set up as the 'index' and another cell set up as the value, which is where the index function resides.
The script will start with 'index' = 1 the run. Once it's done, the script adds 1 to the 'index' and the script runs again. This continues until the cell is 0.
Most of the time this runs without any issues, but every once in a while the loop doesn't add correctly. So what happens is the loop occurs but without adding 1 to the index therefore staying on the same value over and over again. This will happen maybe 2 or 3 iterations before finally adding 1 to the index.
Any idea why this is happening? It's really frustrating because this is used to email a large audience with reports that are unique to user. So when it glitches like this, some users are receiving incorrect reports or multiple reports.
Thank you!
Do
y = Worksheets("index").Range("district_num")
xlsheet.Range("A2:Z150000").ClearContents
Set db = OpenDatabase(DbLoc)
SQL = "SELECT DISTINCT district_num, district_name, district_manager_name, last_name2, first_name2, " & _
"district_mgr_job_title, district_mgr_ee_id, DM_email_email_tbl " & _
"FROM Contacts " & _
"WHERE district_num = " & y
'Execute query and populate the recordset'
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
'Paste Access data in Excel worksheet'
xlsheet.Range("A2").CopyFromRecordset rs
Application.Cursor = xlDefault
'Skips over empty zones'
If Range("A2") <> vbNullString Then
Call Sheet5.DM_auto_email
Else
Sheets("ZD_contact_list").Select 'Important to go back to the contact list so script can continue to run'
End If
Worksheets("Index").Range("district_num_index") = Worksheets("Index").Range("district_num_index") + 1
Loop Until y = 0
So I'm working on automating a tedious process that uncle sam makes us do while deployed. I have a database where we put in a date for each day we are deployed into a table. For instance I have 4/10/2017 through 7/11/2017 listed.
Each day needs the date and location displayed and I need to put six results stacked vertically then move to the right to do the next six three more times.
I have one report named 2282report which is the master one with four subLocation[1-4]s in the appropriate spot. Originally I had it do TOP 6 then the next one would do TOP 6 but where ID > 6 but then I moved to make the date the ID as the date can't be duplicated anyway. I'm unsure of the proper way to make them linked so that the next subreport will display continue the rest.
The report looks like this when ran. I will also have over 90 days usually to list so I will need to create a second page to the main report.
What I'm thinking I'll have to do is create a new subreport for the entire location block but I don't know how to make the report_details move to a new column once it shows 6 results.
Another option I just thought of is to leave the subreports blank then make the master report set the controlsource for each one via vba. I feel this one may work because then it can check to see if there are more days then there are lines so that it can create a new page to continue. But then I need to figure out how to make it continue to the next page. There will also be a bottom section that will only have 16 days versus the 24 on the top.
You might be tempted to use VBA in the various report event handlers, but even if this might work, from my experience that would only lead to headaches trying to get everything to format properly. Instead, I recommend creating a new reporting table with a page number on each row. Source the main report from the sorted page number list and bind a multi-column subreport via the page number field. Populate the reporting table with a simple VBA procedure that correctly paginates the rows according to your scheme.
First the reporting table (add constraints as you find necessary):
CREATE TABLE SubReportTable (PageNum LONG, PageOrdinal LONG, _
Ordinal LONG, LastPage BIT, [Date of Service] DATE, [Location] TEXT)
On the SubReport:
Set RecordSoucre property: SubReportTable (alternatively specify a query that sorts on the desired fields)
Set Number of Columns to 4 along with other column settings (padding, direction, etc.).
Set CanGrow property to No on Detail section and other controls as appropriate.
Resize columns and detail section to properly fit all columns on page. (This will likely require going back and forth between print preview and design on the Main Form.)
On the main report, set the following properties:
RecordSource property: SELECT SubReportTable.PageNum FROM SubReportTable WHERE (((SubReportTable.LastPage)=False)) GROUP BY SubReportTable.PageNum ORDER BY SubReportTable.PageNum
Detail section property Force New Page to After Section.
SubReport object's Link Master Fields and Link Child Fields both to PageNum
Resize SubReport object to fit all columns properly.
Duplicate the behavior on the Main Report on a separate "Last Page" report. Set this report to select the proper subset of records based on the pagination data in the reporting table (i.e. LastPage = True). Depending on how different the last page with 16 records is formatted, it might also require creating a separate SubReport just for the 16 records, but you might get away with using the same SubReport as the main report... that'll be your problem to determine.
RecordSource property: SELECT SubReportTable.PageNum FROM SubReportTable WHERE ((SubReportTable.LastPage = True)) GROUP BY SubReportTable.PageNum ORDER BY SubReportTable.PageNum
Finally some code to populate the reporting table. You can either run this procedure directly from the VBA Immediate Window, or put it in some button's click event handler. The pagination logic can be tweaked to get the right amount of records on the last page.
Public Sub PrepareSubReporTable()
On Error GoTo Catch_PrepareSubReporTable
Dim db As Database
Dim rs As Recordset2
Dim rows As Long, pgs24 As Long, rowsLast24 As Long, rows16 As Long
Dim i As Long, p As Long, pi As Long
Set db = CurrentDb
db.Execute "DELETE * FROM [SubReportTable]", dbFailOnError
db.Execute _
"INSERT INTO SubReportTable ( PageNum, PageOrdinal, Ordinal, LastPage, [Date of Service], [Location] )" & _
" SELECT Null AS PageNum, Null AS PageOrdinal, Null AS Ordinal, False as LastPage," & _
" [Data].[Date of Service], [Data].[Location]" & _
" FROM [Data]" & _
" ORDER BY [Data].[Date of Service], [Data].[Location];", _
dbFailOnError
rows = db.OpenRecordset("SELECT Count(*) FROM SubReportTable").Fields(0)
pgs24 = rows \ 24
rows16 = rows - 24 * pgs24
If rows16 > 16 Then
rowsLast24 = rows16
pgs24 = pgs24 + 1
rows16 = 0
Else
rowsLast24 = 24
End If
Set rs = db.OpenRecordset( _
"SELECT * FROM SubReportTable" & _
" ORDER BY [Date of Service], [Location];")
i = 0
Do Until rs.EOF
p = i \ 24 + 1
rs.Edit
rs![PageNum] = p
If p > pgs24 Then
rs![lastPage] = True
pi = (i - pgs24 * 24) Mod 16 + 1
Else
pi = i Mod 24 + 1
End If
rs![PageOrdinal] = pi
i = i + 1
rs![Ordinal] = i
rs.Update
rs.MoveNext
Loop
rs.Close
Exit Sub
Catch_PrepareSubReporTable:
MsgBox Err.Number & ": " & Err.Description, _
vbOKOnly Or vbExclamation, "Error in PrepareSubReporTable"
End Sub
Now generate the main report and the last-page report, either manually or in VBA code somewhere.
Note: I used the field name PageNum instead of Page because that seemed to cause problems with a SubReport binding during print preview... probably because Page is the name of an existing variable / function for reports.
I have a stored procedure which has 4 input parameters.
#Scenario, #StockID, #EOD, #EOD_PREV.
Based on the #Scenario (total 9 Scenarios), different SQL scripts are executed.
My requirement is:
I need to use VB Macros to display results in each worksheet, I need to use one ActiveX-Command button to run all the Scenarios.
Each Scenario in a separate Worksheet.
So far, I have managed to create individual connections for each sheet and Active X Command Button for each sheet.
Below is the query that I used.
Private Sub CommandButton1_Click()
Dim Scenario As String
Dim STOCK_ID As String
Dim EOD As String
Dim EOD_PREV As String
Scenario = Sheets("Stocks").Range("B3").Value
STOCK_ID = Sheets("Stocks").Range("B8").Value
EOD = Sheets("Stocks").Range("B6").Value
EOD_PREV = Sheets("Stocks").Range("B7").Value
With ActiveWorkbook.Connections("9").OLEDBConnection
.CommandText = "EXEC dbo.usp_Inventory_Reconcilliation '" & Scenario & "','" &
STOCK_ID & "', '" & EOD & "' ,'" & EOD_PREV & "'"
ActiveWorkbook.RefreshAll
End With
End Sub
Can somebody help me out with this situation.
Get the ActiveWorkbook.RefreshAll out of the With, and maybe it'll be easier to use connections without VBA and just use it for your refresh button.
One aspect of my project involves comparing the part number entered by the operator to a predetermined list of part numbers in a column in a database. Right now, my program is telling me that every part number entered in the spreadsheet (50+) does not match any in the database, which I've verified to be incorrect. I've checked that both the spreadsheet part number and the database part number are of string datatype. I've doublechecked that my looping logic is good, and to me seems like it should work. To the best of my knowledge there are no hidden characters in either the database cells or in the spreadsheet cells. I'm completely stumped at this point as to why my program doesn't detect any matches between the spreadsheet and the database. Below is the Sub containing the code for checking that the part numbers match:
Sub CheckPN()
'Connect to the E2 database
Call SetPNConnection
'Open a recordset
Set PNRecordset = New ADODB.Recordset
PNRecordset.Open "EstimRpt", PNConnection, adOpenKeyset, adLockOptimistic, adCmdTable
PNSQLCmd = "SELECT DISTINCT [PartNo] FROM EstimRpt;"
'Loop through data, comparing part numbers to E2 database part number records
TotalBadPNCount = 0
With PNRecordset
For DataRowCount = 2 To TrackingLastRow
PNCount = 0
Part_Number = Tracking.Sheets("Operator Data").Range("A" & DataRowCount).Value
'MsgBox "The datatype for " & Part_Number & " is " & VarType(Part_Number) & "."
Do Until .EOF
'MsgBox "The datatype for " & .Fields("PartNo").Value & " is " & VarType(.Fields("PartNo").Value) & "."
If Part_Number = .Fields("PartNo").Value Then
'If .Fields("PartNo").Value = Part_Number Then
MsgBox Part_Number & " is a match."
PNCount = PNCount + 1
End If
.MoveNext
Loop
If PNCount < 1 Then
MsgBox "The P/N " & Part_Number & " entered in cell A" & DataRowCount & " is incorrect. Please correctly enter the P/N and re-run the program."
TotalBadPNCount = TotalBadPNCount + 1
End If
Next DataRowCount
If TotalBadPNCount >= 1 Then
Exit Sub
End If
End With
PNRecordset.Close
Set PNRecordset = Nothing
PNConnection.Close
Set PNConnection = Nothing
End Sub
On a side note, I'd like to have the entire program stop executing if a part number doesn't match, not just the immediate sub. Currently, just this sub exits upon no part number matches.
Thanks for the help on both of these issues.
Jordan
I'd suggest not using a loop to compare records from your user-submitted dataset to your permanent table. Instead, load the user-submitted dataset into a temporary table in your DB, and use SQL to compare the 2 tables.
You can try something along these lines:
'Load spreadsheet into temp table
<your code here>
'open recordset in order to compare PartNos
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
sSQL = "select count(*) as [count] from temp " _
& " where temp.PartNo not in (select distinct EstimRpt.PartNo from EstimRpt)"
Set rs = db.OpenRecordset(sSQL)
ctRecords = rs![Count]
'if records are found in temp table that do not exist
'in the perm table, then end execution of everything.
if ctRecords > 0 then
End
else
'run the rest of your code
<your code here>
end if
'Drop temp table
<your code here>
I found my problem at long last. The comparing records between database and spreadsheet does work now. I had to make the following changes to my code:
Instead of:
Do Until .EOF
I needed:
Do Until .EOF = True
I also needed to add the following just after the For Loop declaration:
.MoveFirst
Now my code loops correctly.