excel vba: recordset joining and performance - mysql

The Context
I have an app in excel VBA for making read-only queries on a remote database.
Queries are executed from UDF's. My app passes an array of data from the recordset object to the function and Excel's fast process for writing an array to a cell range is invoked.
The Challenge
The app must be able to optionally return field names at the top of the dataset. This is presenting a huge performance challenge for me. The only way I know of to append or prepend to a 2D array in VBA is to loop through the entire array. Normally, I'm spared such a loop by passing the recordset.getRows() object directly to my UDF. However, when combining the list of fields and the result of the query with the looping method (the only method I'm aware of) I double or triple my calculation time for sizable queries.
I benchmarked this: for a query of 2k rows and 5 fields, average calc time without field names included is 4.3 seconds, vs. 9.8 seconds with field names
My first try was to combine the field names and recordset on the server using a UNION clause in my select statement (my server is MySQL). This does not work, however, since UNION forces data-type equality, implicitly converting my numerical data to strings. To convert them back I'd have to loop through the array, negating any efficiency gained.
My Question
Is there any object method of the recordset object or of VBA arrays that could be called upon to prepend a row to a large array without looping through the entire large array? The field names are all known before the MySQL query is executed.
My loop for joining the arrays is below. Define a new array arr of length of the recordset + 1, then loop through it, first adding the fields, then each row of the recordset array:
For r = LBound(arr, 1) To UBound(arr, 1)
If r = LBound(arr, 1) Then
arr(r) = fieldArray
Else
arr(r) = Application.Index(rs_array, r - 1, 0)
End If
Next

Using Application.Index is possibly the slowest way to combine your arrays: use a regular nested loop instead and you won't even notice any hit -
Sub TT()
Dim a(1 To 2000, 1 To 10)
Dim b(1 To 2000, 1 To 10)
Dim cc(1 To 2000)
Dim r, c, t
t = Timer
For r = 1 To 2000
For c = 1 To 10
b(r, c) = a(r, c)
Next c
Next r
Debug.Print "Loop", Timer - t '>> 0.015625 sec
t = Timer
For r = 1 To 2000
cc(r) = Application.Index(a, r, 0)
Next r
Debug.Print "Index", Timer - t '>> 4.195313 sec
End Sub

Related

JSON Result object dynamically written to Excel Worksheet VBA

I am attempting to write a tabular result (columns and rows of data) from an API call into an Excel range / table.
I managed to get it working, but I'd like for this to be dynamic across data sets (my data sets can be any shape with differing field names). As can be seen in the image, I don't necessarily know that the output is 3 columns of data, but I would want to get this from the JsonResult object (it forms part of the object, but I don't know how to access / reference it).
The object also contains the column names of the data which I would like written to Excel as well (as headings), but I don't know how.
Finally I'd like to write the row data to Excel as well, but I don't know how to access these values without specific reference to them (e.g. "company_code").
TO SUMMARISE: The items in yellow in the screenshot as well as the column / field names should be dynamically read from the JsonResult object.
Any assistance would be appreciated.
JsonResult in text: "[{"company_code":"ABC","employee_code":"5","is_exception":"0"},{"company_code":"ABC","employee_code":"8","is_exception":"1"}]"
My code snippet (if it helps):
Set JsonResult = ParseJson(ParseJson(req.responseText)("results")(1)("findings"))("results")
Dim Values As Variant
ReDim Values(JsonResult.Count, 3)
Dim Value As Dictionary
Dim i As Long
i = 0
For Each Value In JsonResult
Values(i, 0) = Value("company_code")
Values(i, 1) = Value("employee_code")
Values(i, 2) = Value("is_exception")
i = i + 1
Next Value
Sheets("Sheet1").Range(Cells(1, 1), Cells(JsonResult.Count, 3)) = Values
This is what ended up working for me:
Dim Item As Dictionary
Dim i As Long, size As Long
size = UBound(JsonResult(1).Keys) + 1
[a1].Resize(, size) = JsonResult(1).Keys 'Header rows
i = 1
For Each Item In JsonResult
i = i + 1
Range("A" & i).Resize(, size) = Item.Items 'Result rows
Next Item
The keys from the collection / dictionary's first Item is used for the Header rows and the items from each item in the collection / dictionary is written to Excel after that.
Works like an absolute charm.

Calculate a Median in SSRS

We need to be able to calculate the median value of a set of figures for a statistical return - specifically the median Answered figures per contract for a date range.
The data is stored in a shared dataset for use in Report Builder, and this shared dataset is used a number of contractual reports so updating it is not an option. The shared dataset being used ensures consistency between contractual reports, so must be used.
There are answers to this already (e.g. Find the median of a calculated field in SSRS 2012 & Use of 'median' function in calculated field in SSRS) but these require either hidden rows/columns or using a calculated field in a graph.
We need an answer that allows us to use shared datasets/stored procedures and calculate the median value in SSRS/Report Builder.
This custom code can be added to the report:
Public Shared Function Median(ByVal items As Object()) As Decimal
If items Is Nothing Then
Return Nothing
End If
Dim counter As Integer = items.Length
If counter = 0 Then
Return 0
End If
System.Array.Sort(items)
If counter Mod 2 = 1 Then
Return items(CInt((counter / 2) - 0.5))
Else
Dim FirstIndex As Integer = counter \ 2
Dim SecondIndex As Integer = FirstIndex - 1
Dim FirstValue As Integer = items(FirstIndex)
Dim SecondValue As Integer = items(SecondIndex)
Return (FirstValue + SecondValue) / 2
End If
End Function
Which can then be called by using the following =Code.Median(Lookupset(Fields!Contract.Value, Fields!Contract.Value, Fields!Answered.Value, "DS_CallData_LKP"))
In this example the dataset "DS_CallData_LKP" is powering the entire report, but is being referenced back again to get list of values to be sorted for the median. Using a lookupset() instead of the hidden rows/columns method that is seen a lot helps keep the report simple for editing later down the line.

Access will only retrieve data from 1 table in a join with no where clause

I am using MS-Access to get information from 2 tables. I have used inner join, left, right, and outer with all variations, and it will either pull 1 row when 316 are expected, all data for the fields in test with no values for the fields from test 1, or all data for fields from test 1, and no values for test. How do I resolve this? The actual fields had to be changed for privacy, but the below is the exact layout.
SELECT [TEST].a,
[TEST].b,
[TEST].c,
[TEST 1].[D],
[TEST].E,
[TEST].F,
[TEST].G,
[TEST].H,
[TEST 1].[I],
[TEST].J,
[TEST].K,
[TEST 1].L,
[TEST 1].[M]
FROM [TEST 1]
INNER JOIN [TEST] ON [TEST 1].[ID] = [TEST].[CLAIMSNO];
This is a data-validation and debugging exercise, so if you can't share concrete example data then there is really no definite answer to this question. Technically it may not be answerable according to common StackOverflow standards, but I feel generous right now.
Since the joined fields are text, there are various possibilities keeping them from matching: extra spaces, null-terminated strings, case sensitivity (although Access by default should be case insensitive), wide (Unicode) vs narrow (ASCII, UTF-8) encoding, etc. You did not reveal where the data came from, nor how it was loaded into the database, so I make no assumptions. In order to understand the data and determine the reason for the failed matches, you need to investigate the details of the strings. You could likely narrow the problem by investigating the source of the data values and understanding the range of possible characters, encoding, string termination, etc.
Since you are already having troubles matching data AND since you already indicated that the original tables had no primary key or indexes, I highly recommend adding a new AutoNumber field with a unique index to each table, perhaps named [AID] (for AutoNumber ID). Do this even if you have added indices to existing columns. This will at least provide a reliable "handle" to select and refer to a particular row while debugging the other columns.
The big idea is to use VBA or other built-in functions to inspect and report on various attributes of the string values. There are just too many ways you could do this, but my preference is to create a public VBA function in a normal VBA module and then call this function from an SQL query. Although you could do this for every row, instead I suggest manually choosing rows from each table which you think should match... record the [AID] value for each row. If the manually-selected rows don't result in anything enlightening, then run it against an entire table and see what interesting results you get.
Consider these functions:
Public Function CheckSpaces(val As Variant) As String
Dim result As String
If IsNull(val) Then
result = "Null"
ElseIf VarType(val) = VbVarType.vbString Then
If Len(val) = 0 Then
result = "Empty String"
Else
Dim temp As String
Dim n As Integer, m As Integer
n = Len(val)
result = "Length " & n
temp = LTrim(val)
m = Len(temp)
If n <> m Then
result = result & " AND " & (n - m) & " left spaces"
End If
temp = RTrim(val)
m = Len(temp)
If n <> m Then
result = result & " AND " & (n - m) & " right spaces"
End If
End If
Else
result = "Not a string!"
End If
CheckSpaces = result
End Function
Public Function NullChar(val As Variant) As Boolean
Dim result As Boolean
result = False
If Not IsNull(val) Then
If VarType(val) = VbVarType.vbString Then
If InStr(val, vbNullChar) > 0 Then 'vbNullChar = Chr(0)
result = True
End If
End If
End If
NullChar = result
End Function
And execute queries similar to the following. Let's say that [Test 1] row AID = 10 has [ID] == 'name'. Likewise, imagine row AID == 20 of [Test] has [CLAIMSNO] = ' name ':
SELECT [ID], CheckSpaces([ID]), NullChar([ID])
FROM [TEST 1]
WHERE [AID] = 10
and
SELECT [CLAIMSNO], CheckSpaces([CLAIMSNO]), NullChar([CLAIMSNO])
FROM [TEST]
WHERE [AID] = 20
Compare the returned values. Is there anything that indicates a failed match?

Using a User-Created Function in VBA to output criteria in access query

In short: I have a user-created function (gettargetTemp(targetTemp_input) with one input that, upon function evaluation, I would like to be able to call the function in an Access query (design view) criteria field and have it represent the criteria string that I want evaluated when the query is run.
i.e. targetTemp_input = 1450 - this value is assigned from a form (and can vary)
Access Query
Field: Pad Temp
Criteria: gettargetTemp("targetTemp_input")
Criteria possibilities:
- Records within 100 degrees of the targetTemp_input value which
typically in Access query design is: Between 1350 and 1550 Or Is Null
- All of the records
The code that makes sense to me is:
Public Function gettargetTemp(targetTemp_input)
If Forms![Parameter Confirmation].tempCheck = True Then
gettargetTemp = "Between " & (targetTemp_input - 100) & " AND " _
& (targetTemp_input + 100)
Else
End If
End Function
The outcome of this typically results in a data mismatch error from Access. Is there a way to accomplish what I'm trying to do? Or maybe do it better? I'm not a programmer, but I have a pretty good technical background.
At present, you're trying to have the VBA function form an expression that does the wanted test, rather than doing the test itself. You need to change that:
Function IsTempOK(Temp) As Boolean
Dim ParamForm As Access.Form, TargetTemp As Long
Set ParamForm = Forms![Parameter Confirmation]
If ParamForm.tempCheck Then
If IsNull(Temp) Then
IsTempOK = True ' or False, if that's what you want
Else
TargetTemp = ParamForm.TargetTemp ' or wherever this is defined
IsTempOK = (Temp >= TargetTemp - 100) And (Temp <= TargetTemp + 100)
End If
Else
IsTempOK = True
End If
End Function
In the query definition, the WHERE clause should now use IsTempOK, passing the Temp field as the parameter.

Using transcations and parameters in ADO in VBScript

I'm a bit stuck with parameters and transactions in ADO, in VBScript and Access. Basically, I'm working through a massive loop and writing the results to a database, so I need to wrap it in a transaction otherwise it takes ages.
I've written the below script which works for a single parameter, (although this seems a bit of a long way of doing it, so if anyone knows a shorter way, please shout). However I can't work out how to expand this to two parameters:
objConn.BeginTrans
set oParm = CreateObject("ADODB.Parameter")
oParm.Value = ""
oParm.Type = 200
oParm.Direction = 1
oParm.Size = 100
Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = objConn
oCmd.commandText = "INSERT INTO table (field) VALUES (?)"
oCmd.commandType = 1
oCmd.Parameters.Append oParm
'Big loop here that goes through lots of lines.
oCmd.Execute ,"Field",1
'Loop
objConn.CommitTrans
For example, if I wanted to expand this to:
oCmd.commandText = "INSERT INTO table (field1, field2) VALUES (?,?)"
I can't figure out what I do with my parameters. I'm sure I'm just being stupid here and not quite following how these work.
I've never tried passing parameter values through the Execute method, so I can't quite say what's wrong. I will say that the documentation states that the second argument should be an array of values, so maybe if you tried Array("Field1Val", "Field2Val"), that would work.
What I usually do is give each parameter a name, then you can reference it within your loop to change its value. You can use any name you like, as long each parameter has a unique name. As an example:
' Sometime before your loop
oParm.Name = "foobar"
' Start loop
oCmd.Parameters("foobar").Value = "someValue"
oCmd.Execute , , 1
' End loop
As far as shortening the code, the only suggestion I can make is using the CreateParameter method to, well, create the parameter. That will allow you to set all the relevant properties on one line.
Set oParm = oCmd.CreateParameter("foobar", 200, 1, 100)