I'd like to determine the effect that changes to my queries are having. To do this, I need some performance metric. Is it possible to determine the execution time for a query in MS Access? Using external programs, or changing the registry (SHOWJETPLAN) are not an option as my workstation is really locked down by the network admins... so I need an in-Access solution. Thanks!
I have a quick and dirty approach that I use for evaluating relative performance of alternative algorithms, be they different functions, queries, etc.
I make use of the Run command of the Access.Application object. It allows me to quickly compare 2, 3, 4, etc., different approaches. For each additional approach, I just create another Function named ThingX.
I then use the number of iterations to work around GetTickCount's limitation of roughly 10 ms accuracy. If you want even finer resolution than GetTickCount can provide, you can use a high-resolution timer like QueryPerformanceCounter. Personally, I don't think that is worth all the extra work. If you are writing performance critical code in VBA and are worried about shaving microseconds off your execution time, you're using the wrong tool (VBA) for the job.
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub TimeThings() 'vv
Const NumThings = 2
Const Iterations = 2500
Dim t As Integer, i As Integer, s As Long
For t = 1 To NumThings
s = GetTickCount
For i = 1 To Iterations
'Debug.Print Run("Thing" & t, i)
Run "Thing" & t, i
Next i
Debug.Print "Thing "; t, GetTickCount - s; " ms elapsed"
Next t
End Sub
Function Thing1(Optional Val)
Dim i
For i = 1 To Val
Thing1 = Thing1 & Chr(65 + (i Mod 57))
Next i
End Function
Function Thing2(Optional Val)
Dim i
Thing2 = Space(Val)
For i = 1 To Val
Mid(Thing2, i) = Chr(65 + (i Mod 57))
Next i
End Function
On my system, running TimeThings() yields the following output:
Thing 1 4087 ms elapsed
Thing 2 2652 ms elapsed
Related
I am trying to find the row number in a sheet using the .Find function in a recursive function.
I set an object called Found = .Find.... and it works great... for a little bit. I set it when I'm 1 level of recursion deep, then set it again when I'm 2 levels deep. Then, my code finds the end of the path and starts backing up until it gets back to 1 level deep, but not my Found object has been re-declared and kept its values from the 2nd level. My other variables (ThisRow etc...) keep the value of the level that they are in, and that's what I would like to do with the object Found. Is there a way that I can declare Found locally so that it's value doesn't extend to the next function, and can't be overwritten in a deeper level? You can find my code below for reference.
Here is my current code - irrelevant parts cut out:
Public Function FindChildren()
ThisRow = AnswerRow 'Also declared before function call
BeenHereCell = Cells(ThisRow, "O").Address
If Range(BeenHereCell).Value = "Yes" Then
Exit Function 'That means we've already been there
End If
Range(BeenHereCell).Value = "Yes"
With Worksheets("MasterScore").Range("j1:j50000")
Set Found = .Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
firstAddress = Found.Address
NextCell = Found.Address
Do
AnswerRow = Range(NextCell).Row
FindChildren 'This is where it's recursive.
Set Found = .FindNext(Found)
NextCell = Found.Address
Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
End With
End Function
Now I have gotten around it by activating cells, but it makes my code a lot slower. Currently I am using this:
Set Found = Worksheets("MasterScore").Range("j1:j50000").Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
Count = 1
Do
Columns("J:J").Select
FirstFoundRow = Selection.Find(What:=NextQuestionID, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Row
For i = 1 To Count
Selection.FindNext(After:=ActiveCell).Activate
Next i
AnswerRow = ActiveCell.Row
If AnswerRow = FirstFoundRow And Count <> 1 Then Exit Do
FindChildren
Count = Count + 1
Loop
End If
This way, I don't have to set the value of the object again, but I have to iterate through it.FindNext quite a few times and each time it runs that line its also activating the row. I really just want something like.
AnswerRow = .Find(nth instance of NextQuestionID).Row
(I have about 50k rows and the count goes to about 20 pretty often so it really takes a while).
I'd appreciate any ideas! Currently my code is working, but it's going to take a good part of the day to complete, and I'll need to run this again at some point!
I ended up finding a way to speed it up a little bit. I think this could help someone so I will share what I've found.
It's not the best solution (I would have preferred to just declare the object locally so my other functions wouldn't change it's value), but at least with this I'm not looping through 20 or so finds every iteration of the Do Loop.
Set Found = Worksheets("MasterScore").Range("j1:j50000").Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
NextAnswerRange = "j" & 1 & ":" & "j50000" 'The first search will be from the beginning
Do
Set Found = Worksheets("MasterScore").Range(NextAnswerRange).Find(NextQuestionID, LookIn:=xlValues)
NextCell = Found.Address
AnswerRow = Range(NextCell).Row
NextAnswerRange = "j" & AnswerRow & ":" & "j50000"
If LastAnswerRange = NextAnswerRange Then Exit Function 'This would mean we've reached the end.
LastAnswerRange = NextAnswerRange
FindChildren
Loop
End If
End Function
So we know we've already covered our bases with previous ranges since it always finds the immediate next. We just change the range of the search each time and it will find the next value.
A weird thing about this solution is that if you are looking for a value among range 70 -> 50,000 and you have the answer your looking for on row 70, it will actually find the next row (it skips that first one). But, if there aren't any rows past 70 that have the answer, it will actually take the value from row 70. That meant that I couldn't do
NextAnswerRange = "j" & AnswerRow + 1 & ":" & "j50000"
because it would miss some values. Doing it without the + 1 meant at the end of the document I would end up searching the same last value over and over (it would never go back to Found Is Nothing) so I had to put in the check to see if the LastAnswerRange = NextAnswerRange.
I hope this helps someone. I don't think it's the most elegant solution, but it's a lot faster than what I had.
I have a problem with a function in matlab. This specific function is for filtering light signals. As you can see below I added the coding I’ve used in the function and in the while loop itself. The code is written for a NXT Lego robot.
Is there any tip how to get the count variable ( i = i + 1 ) to work in the function, so we can plot Light(i)? Because we’re getting a bunch of error messages when we try different codes to make it work.
function [light] = filter_func( i)
lightI(i) = GetLight(SENSOR_3);
if i==1
light(i)=lightI(i)
elseif i==2
light(i) = 0.55*lightI(i) + 0.45*lightI(i-1)
else
light(i) = 0.4*lightI(i) + 0.3*lightI(i-1) + 0.3*lightI(i-2);
end
end
i=1
while true
lightI(i) = GetLight(SENSOR_3); % Get’s a lightvalue between 0 and 1024.
if i>2
light =filter_func(i)
light=round(light);
else
light(i) = GetLight(SENSOR_3);;
end
i=1+i
plot(light(end-90:end), 'r-');
title('Lightvalue')
axis([0 100 0 1023]) ;
end
You probably mainly get errors because you are not allowed to mix script and functions like this in MATLAB (like you are in Python).
Your filter function is only used when i>2 so why are you doing the first 2 tests? It seems like you want lightI as a global variable, but that is not what you have done. The lightI inside the function is not the same as the one in the while loop.
Since your while loop runs forever, maybe you don't need to worry about updating the plot the first two times. In that case you can do this:
filter = [0.4 0.3 0.3]';
latest_filtered_light = nan(90,1);
lightI = [];
p = plot(latest_filtered_light, 'r-');
title('Lightvalue')
axis([0 100 0 1023]) ;
while True
lightI(end+1,1) = rand*1024; % Get’s a lightvalue between 0 and 1024.
if i>=3
new_val = lightI(end-2:end,1)'*filter;
latest_filtered_light = [latest_filtered_light(2:end);...
new_val];
set(p, 'ydata', latest_filtered_light)
drawnow
end
end
I think it is an important point to not call plot every time - at least if you are the least concerned about performance.
So, I inherited some code (below) from someone else and I'm trying to understand how it works. I understand msot of the code (though I'm pretty new to Access VBA) but the one part I don't get is how this code groups all the info for one policy together.
The situation is as follows. To get premium data for a specific policy, from our company database, we have to get it one coverage per line. But, I want all premiums, one for each coverage, all on the same line. So, this code puts it all together from many lines into one line. For simplicity, I knocked it down to 3 total coverages, though there are many more. As I read the code, it seems to assume that all the info for one policy is together, like the 1, 2, or 3 rows for a specific policy are in order. But, even when I, for example, order the table by the premium (amount) column, it still gets all the premium for one policy on one line. I don't see anywhere in the code that should make this work. The code is comparing the policy number on one line to the policy number on the next. If they are the same, group the premium together. If they are different, don't. Again, I could order the table so that the records for one policy are not together, but the end result still comes out right. Am I missing something? Is it something in Access doing it? Thanks for any help!
Option Compare Database
Option Explicit
' Premium is imported with one row for each coverage per policy, so possibly several rows per policy.
' This procedure takes several rows per policy and makes them into one row.
Sub ScrubPremium()
Dim i As Long, j As Long, k As Long
Dim NumRecords As Long, found As Long, UniqueCount As Long
Dim tempPolicyNum As String, tempCoverage As String, tempPremium As Single
Dim PolicyNumArray() As String, PremiumArray() As Single, TotalPremiumArray() As Single
Dim db As DAO.Database
Set db = CurrentDb
Dim infile As Variant, outfile As Variant
Set infile = db.OpenRecordset("Imported Premium")
CurrentDb.Execute "DELETE * FROM [Finalized Premium]"
Set outfile = db.OpenRecordset("Finalized Premium")
NumRecords = infile.RecordCount
ReDim PolicyNumArray(NumRecords)
ReDim PremiumArray(NumRecords, 3)
ReDim TotalPremiumArray(NumRecords)
infile.MoveFirst
'initialize PremiumArray
For i = 1 To NumRecords
For j = 1 To NumPremiums
PremiumArray(i, j) = 0
Next j
Next i
'populate arrays
UniqueCount = 0
For i = 1 To NumRecords
tempPolicyNum = infile![Policy_Number]
tempCoverage = infile![Coverage]
tempPremium = infile![Premium]
k = 0
found = 0
Do Until k = UniqueCount Or found = 1 'check for unique policy
If tempPolicyNum = PolicyNumArray(k + 1) Then
found = 1
Else
k = k + 1
End If
Loop
If found = 0 Then
UniqueCount = UniqueCount + 1
PolicyNumArray(k + 1) = tempPolicyNum
End If
Select Case tempCoverage
Case "Comprehensive"
j = 1
Case "Collision"
j = 2
Case Else
j = 3
End Select
PremiumArray(k + 1, j) = PremiumArray(k + 1, j) + tempPremium
TotalPremiumArray(k + 1) = TotalPremiumArray(k + 1) + tempPremium
infile.MoveNext
Next i
'Populate table
For i = 1 To UniqueCount
outfile.AddNew
outfile![Full Policy Number] = PolicyNumArray(i)
outfile![Comp Premium] = PremiumArray(i, 1)
outfile![Coll Premium] = PremiumArray(i, 2)
outfile![Other Premium] = PremiumArray(i, 3)
outfile![Total Premium] = TotalPremiumArray(i)
outfile.Update
Next i
infile.Close
outfile.Close
End Sub
The code is comparing the policy number on one line to the policy
number on the next. If they are the same, group the premium together.
If they are different, don't.
Almost.
There are two loops here. One walks through each row of your input file. On each row of the input file, a second loop walks through (potentially all of) PolicyNumArray, looking for policy numbers that match the number taken from the input file.
If I were you, I'd step through this with the debugger. Make sure it's doing what you expect it to do. I'd want to look closely at this part (some lines snipped).
UniqueCount = 0
For i = 1 To NumRecords
k = 0
Do Until k = UniqueCount
I've been looking around and I have not been able to find anything that has worked for me. I'm starting to learn more Lua and to start off I'm making a simple calculator. I was able to get each individual operation onto separate programs, but when I try to combine them I just can't get it to work. My script as it is now is
require "io"
require "operations.lua"
do
print ("Please enter the first number in your problem.")
x = io.read()
print ("Please enter the second number in your problem.")
y = io.read()
print ("Please choose the operation you wish to perform.")
print ("Use 1 for addition, 2 for subtraction, 3 for multiplication, and 4 for division.")
op = io.read()
op = 1 then
function addition
op = 2 then
function subtraction
op = 3 then
function multiplication
op = 4 then
function division
print (answer)
io.read()
end
and my operations.lua script is
function addition
return answer = x+y
end
function subtraction
return answer = x-y
end
function multiplication
return answer = x*y
end
function division
return answer = x/y
end
I've tried using
if op = 1 then
answer = x+y
print(answer)
if op = 2 then
answer = x-y
print(answer)
and I did that completing each operation. But it doesn't work. I can't even get the error code that it's returning because it closes so fast. What should I do?
In your example, make these changes: You require operations.lua without the extension. Include parameters in your operations function definitions. Return the operation expression directly versus returning a statement like answer = x+y.
All together:
Code for operations.lua
function addition(x,y)
return x + y
end
--more functions go here...
function division(x,y)
return x / y
end
Code for your hosting Lua script:
require "operations"
result = addition(5,7)
print(result)
result = division(9,3)
print(result)
Once you get that working, try re-adding your io logic.
Keep in mind that as it's coded, your functions will be defined globally. To avoid polluting the global table, consider defining operations.lua as a module. Take a look at the lua-users.org Modules Tutorial.
The right if-then-else syntax:
if op==1 then
answer = a+b
elseif op==2 then
answer = a*b
end
print(answer)
After: please check the correct function-declaration syntax.
After: return answer=x+y is incorrect. If you want set answer's value, set without return. If you want return the sum, please use return x+y.
And I think you should check Programming in Lua.
First of all, learn to use the command line so you can see the errors (on Windows that would be cmd.exe).
Second, change the second line to require("operations"). The way you did it the interpreter expects a directory operations with an underlying script lua.lua.
In my job, I have inherited an Access 97 database. This database is very unstable and I need to remedy that in one way or another. I have been trying to go through and debug the current version so that I can migrate it to 2007. I have run across some code that the compiler doesn't like and not sure how to fix it...here is the code:
Function DaysInMonth(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
Select Case Month(D)
Case 2
If LeapYear(Year(D)) Then
DaysInMonth = 29
Else
DaysInMonth = 28
End If
Case 4, 6, 9, 11
DaysInMonth = 30
Case 1, 3, 5, 7, 8, 10, 12
DaysInMonth = 31
End Select
End Function
I get a compile error: Sub or Function not defined and it highlights the first "LeapYear".
Any help at all would be greatly appreciated! Thanks!
LeapYear is another function or procedure that appears not be present in your modules or has been made Private. LeapYear isn't a VBA function. There must have been a function that takes a year Year(D) and returns TRUE or FALSE if it's a leapyear. either insert one or set the existing one to Public
Edit:You could use IsLeapYear but change to 'LeapYear' and call using IsLeapYear(D)
The code in question is idiotic -- it was clearly written by somebody who didn't have a clue about VBA dates, which already know everything that is needed without needed to encode this crap into a CASE SELECT.
This expression will get you the number of days in a month:
Day(DateAdd("m", 1, DateValue(Month(Date()) & "/1/" & Year(Date()))) - 1)
What this does is get the first of the current month, adds a month to it (for the first of the next month), and then subtracts 1 from it. Since the integer part of the VBA date type is the day part, that will get you the last day of the current month. Then you take the result and pull the day out with the Day() function.
Coding that up as a function:
Function DaysInMonth(ByVal dteDate As Date) As Integer
Dim dteFirstOfMonth As Date
Dim dteLastOfMonth As Date
dteFirstOfMonth = DateValue(Month(dteDate) & "/1/" & Year(dteDate))
dteLastOfMonth = DateAdd("m", 1, dteFirstOfMonth) - 1
DaysInMonth = Day(dteLastOfMonth)
End Function
You could also code this up using the fact that the DateSerial() function treats the zeroth day as the last of the previous month:
Function DaysInMonth(ByVal dteDate As Date) As Integer
Dim dteOneMonthFromDate As Date
Dim dteLastOfThisMonth As Date
dteOneMonthFromDate = DateAdd("m", 1, dteDate)
dteLastOfThisMonth = DateSerial(Year(dteOneMonthFromDate), Month(dteOneMonthFromDate), 0)
DaysInMonth = Day(dteLastOfThisMonth)
End Function
But that doesn't make it any shorter...
None of this requires figuring out leap year rules -- those are built into the VBA date type.
And, of course, the function should not return a Long, but an Integer, since the maximum value it can ever return is 31.
LeapYear may not be your only issue.
In Access '97, go to the VBA editor and click "Tools/References":
Look in the references of your '97 project and see what DLLs are listed.
A screen will appear that shows you the ActiveX DLLs that can be used for the project. The ones that are checked are the ones currently used:
Odds are there is a DLL there that needs to be referenced in your new 2007 database.