Populating reports with calculated values - vba

I hope this is a simple question and you don't have to waste too much of you time on it.
I have an report (called repRAD78) which contains a textbox (called txtRAD8). I would like to populate txtRAD8 with a calculated value based on numbers pulled from a query called qryrRAD78.
Looking through the forums it looks like recordsets would be the solution but this is my first foray into recordsets and it's not going well. :(
The code I have pasted in below I have pulled together from a number of places and it doesn't produce any errors but puts the same value into txtRAD8 for all the records.
I'm sorry if this is a stupid question but it's been driving me potty.
Many thanks for your time.
Al.
Public Sub Calc()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryrRAD78")
rst.MoveFirst
Do Until rst.EOF = True
Dim lngMean As Long
Dim lngRAD78max As Long
Dim lngRAD78_1 As Long
Dim lngRAD78_2 As Long
Dim lngRAD78_3 As Long
Dim lngRAD7 As Long
Dim lngRAD8 As Long
lngRAD78_1 = rst![RAD78_1]
lngRAD78_2 = rst![RAD78_2]
lngRAD78_3 = rst![RAD78_3]
lngRAD8b_c = rst![RAD8b_c]
lngMean = (lngRAD78_1 + lngRAD78_2 + lngRAD78_3) / 3
lngRAD78max = Maximum(Abs(lngRAD78_1), Abs(lngRAD78_2), Abs(lngRAD78_3))
lngRAD7 = ((lngRAD78max - lngMean) / lngMean) * 100
lngRAD8 = ((lngMean - lngRAD8b_c) / lngRAD8b_c) * 100
txtRAD8.Value = lngRAD8
rst.MoveNext
Loop
rst.Close
dbs.Close
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Calc
End Sub

Here's a second approach to this. Rather than using a function in the code, take the calculations from your Calc() routine and put them in another query.
SELECT idrRAD78,
(RAD78_1 + RAD78_2 + RAD78_3) AS Mean,
(IIf(Abs(RAD78_1) > Abs(RAD78_2),
IIf(Abs(RAD78_1) > Abs(RAD78_3), RAD78_1, RAD78_3),
IIf(Abs(RAD78_2) > Abs(RAD78_3), RAD78_2, RAD78_3))) AS RAD78Max,
(((RAD78max - Mean) / Mean) * 100) AS RAD7,
(((Mean - RAD8b_c) / RAD8b_c) * 100) AS RAD8
FROM qryrRAD78
This will give you a query that performs the same calculations as your existing function. Then just edit the report query to join to this new query (just like joining a table) using something like:
FROM ReportQuery INNER JOIN NewQuery ON ReportQuery.idrRAD78 = NewQuery.idrRAD78
Change the query names to match the real names. Add the fields from the new query in the SELECT part of your report query:
SELECT <existing field list>, RAD7, RAD8
Then set txtRAD8 to the RAD8 field.
I'm just doing this from memory as I'm not in front of my own computer, but hopefully that makes sense and is close enough to the correct code.

The problem with this function is that every row on the report is going to have a textbox called txtRAD8. So what you are really doing is updating every textbox on the report with the same value (once for every loop through the recordset). You are not actually setting the value for each individual row.
What you need to do is make the value of the textbox = Calc(RowID). Then your query uses the passed-in parameter to get the value for that one record instead of looping through the whole recordset, and updates just that one row on the report.
So your Sub becomes a Function, and returns the calculated value.

Related

Storing field names from a query table into a dynamic array MS Access

I have a Query qryRuleSets which outputs a table with 19 fields (that I do not want to save into an access table before that is suggested). I would like to get the field names and store them into an array so I can use that array in a for loop later on.
To find the number of fields that in the query result (to use in for loop later on) I have implemented the following, where the number of fields is stored in the variable numberfields -
numberfields = CurrentDb.QueryDefs("qryrulesets").Fields.Count
To actually get the name of these fields and store them in an array I am running into 2 problems:
1. Getting the field names from the query result
2. Setting up a dynamic array so that if the query ends up returning a table with more or less than 19 fields, it will still work
For my first problem:
I have tried to follow the steps in the following link: Get Column name from a query table but I can't figure it out.
To get the field names from the qry result I have tried the following but I'm not overly knowledgeable in vba/access so finding it hard to understand, even after a whole lot of googling:
Dim qry As QueryDef
Dim fieldNames As QueryDef
Dim firstcol As String
Set fieldNames = CurrentDb.CreateQueryDef(qry.qryrulesets)
firstcol = fieldNames.field(0).Name
For my second problem:
To store values in an array I have tried the following (as a test) and it works but I have to define the size of the array. Is there a way where it can be dynamic, i.e based on the value of the number of fields (found above stored in numberfields) :
Dim vardata(30) As Variant
For i = 1 To numberfields
vardata(i) = "hello"
Next i
I tried making the '30' above to a variable value but it didn't like that.
Any and all help will be appreciated. Thanks!
You can do like this:
Public Function GetFieldNames(ByVal QueryName As String) As String()
Dim Query As DAO.QueryDef
Dim FieldNames() As String
Dim Index As Integer
Set Query = CurrentDb.QueryDefs(QueryName)
ReDim FieldNames(0 To Query.Fields.Count - 1)
For Index = LBound(FieldNames) To UBound(FieldNames)
FieldNames(Index) = Query.Fields(Index).Name
Next
GetFieldNames = FieldNames()
End Function

vba store recordset as integer variable

First time poster, I finally had a question that I couldn't find an answer to here.
I have an MS Access query that returns 1 result (which is a number) that I want to store as an integer variable (x) so I can use it later for a loop. The issue is that because I'm using it as a recordset and the variable is an integer, I'm receiving a "Type Mismatch" error.
Right now I'm just storing the result to a cell and setting the variable equal to the cell:
Ws.Range("A1") = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
x = Ws.Range("A1")
Ws.Range("A1").Delete
And then later I just have a loop that runs x times:
For i = 0 To x
Basically, I just want to have some code that looks like this:
x = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
Any help here would be huge. Thank you!
The following should give you the correct result:
Dim x As Integer
Dim db As DAO.Recordset
db.MoveFirst
If IsNumeric(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value) Then
x = CInt(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value)
Else
MsgBox "The query did not return a number." & Chr(10) & "Aborting..."
End If
Note, that you are using DAO and not ADO as your original tags on the post indicated. Still, they both behave rather similar and the cursor is normally on the first row (when the data is returned). So, MoveFirst should not be necessary. Still, Microsoft themselves keep using it in its own sample code all the time. The first column if for DAO and ADO alike .Fields(0).

Is it possible to add cases to a Select Case based on the number of entries in a table?

I've been messing around with VBA in Excel a bit recently; and as a small project for myself, I'm trying to create a "draw names from a hat" sort of macro.
I began by generating a random number, and then choosing which entry from a Table (i.e. ListObject) would be selected using a case statement. The problem with this is that it only works of the number of Table entries is always the same.
So my question (probably a ridiculous one) is: is it possible at all to generate a dynamic 'Select Case' block, where the number of cases on the block is based on the number of entries in the Table?
Thanks.
-Sean
Edit: To clarify: what I am trying to do, exactly, is this:
I generate a random number, i, from 1 to n=10*(number of Table entries). After this, I want to display, in a cell, one of the table entries based on the random number.
Ideally, the code would work similarly to this:
if i = 1 to 10 then choose event 1
if i = 11 to 20 then choose event 2
if i = 21 to 30 then choose event 3
...
if i = (n-9) to n then choose event (n/10)
I hope this helps to clarify the goal of the code.
From our comments here is something you can use:
Sub random()
Dim used_rows As Integer
Dim random As Integer
Dim cell_array() As Integer
used_rows = Sheet1.UsedRange.Rows.Count
ReDim cell_array(used_rows)
For i = 1 To used_rows
cell_array(i - 1) = Cells(i, 1)
Next
random = Int(Rnd * (used_rows))
MsgBox cell_array(random)
End Sub
You can go ahead and change MsgBox to whatever you like, or set like Cell(1,4).Value = cell_array(random), or however you'd like to proceed. It will be based off the number of rows used. Though depending on how you implement your spreadsheet the code might have to be changed a bit.
Here's the update code from the suggestions from the comments. Also remember to use Randomize() in your form initialization or WorkBook Open functions.
Sub random()
Dim used_rows As Integer
Dim random As Integer
'Multiple ways to get the row count, this is just a simple one which will work for most implementations
used_rows = Sheet1.UsedRange.Rows.Count
random = Int(Rnd * (used_rows))
'I use the variable only for the reason that you might want to reference it later
MsgBox Cells(random, 1)
End Sub
This assumes that by "table" you mean "Table with a capital T", known in VBA as a ListObject:
Sub PickRandomTens()
Dim lo As Excel.ListObject
Dim ListRowsCount As Long
Dim RandomNumber As Long
Dim ListEvent As String
Dim Tens As Long
Set lo = ActiveSheet.ListObjects(1)
ListRowsCount = lo.DataBodyRange.Rows.Count
RandomNumber = Application.WorksheetFunction.RandBetween(10, ListRowsCount * 10)
ListEvent = lo.ListColumns("Data Column").DataBodyRange.Cells(Int(RandomNumber / 10))
MsgBox "Random number: " & RandomNumber & vbCrLf & _
"Event: " & ListEvent
End Sub

access help to dynamicaly determin a records date changes across fields

i have a MS access database with a table such as the one below and i am trying to figure out the sql needed to determine the total number of times the date changes across all the fields for each defectID record.
also, note that each day i add a field to the table, so if this can be made dynamic that would be best.
when there are no dates i would like the result to display 0 (zero)
thanks all
you definitely have a normalization issue here.
you should consider moving the date to another table - maybe similar to the following:
Retest Estimate
-----------------
defect_id
estimate_date
ready_date
You are treating a database like a spread sheet. It would be better to set up a table on these lines:
DefectID
TestDate
Est_ReadyForRetest
This means that you are adding records each day, rather than fields. It will also make queries easier.
I agree with the suggestion that the data ought to be normalized, but then you have a different problem for answering the question, one that I'm not sure how you'd do it in SQL (since it is based on the order of the records). That is, you'd have to walk a recordset to do it. I guess a correlated subquery could do the trick, but it would have to based on something that can be ordered.
My SQL skills are not fabulous, so in the abstract I won't suggest a SQL solution, but maybe somebody else will.
Instead, I'll suggest a function that could return the answer in the original unnormalized data structure. I base this on my existing iMax() function, which goes like this:
Public Function iMax(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID
' rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim lngUBound As Long
Dim v As Variant
v = p(LBound(p))
lngUBound = UBound(p)
For i = LBound(p) + 1 To lngUBound
If v < p(i) Then
v = p(i)
End If
Next
iMax = v
End Function
The idea is using a parameter array to pass the values to the function, and then walking the array to get the information you need. In this case, you'd want to walk the array and count the number of times it changes, something like this:
Public Function CountChange(ParamArray varInput()) As Long
Dim varValue As Variant
Dim varPrevious As Variant
Dim lngCount As Long
varPrevious = varInput(0)
For Each varValue In varInput()
If varValue <> varPrevious Then
lngCount = lngCount + 1
End If
varPrevious = varValue
Next varValue
CountChange = lngCount
End Function
I haven't tested that very thoroughly, and it doesn't deal with Nulls at all, but that's the idea -- it's very useful concept for comparing data from fields within a single row.

Inspecting a Word mail merge data source programmatically

I want to iterate over all rows of a MS-Word mail merge data source and extract the relevant data into an XML.
I'm currently using this code:
Imports Microsoft.Office.Interop
Do
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
If DataSource.ActiveRecord = LastRecord Then
Exit Do
Else
DataSource.ActiveRecord = Word.WdMailMergeActiveRecord.wdNextDataSourceRecord
End If
Loop
And it turns out to be a little sluggish (About 1 second for each row). Is there any way to do it faster?
My fantasy is finding a function like MailMergeDataSource.ToDatatable and then inspecting the datatable.
Any time you're iterating through something row by row, and then doing some kind of processing on each row, is going to get a little slow.
I would be inclined to approach this problem by having a step before this which prepared the mdictMergeFields collection so that it only contained elements that were not 'null or empty', this will mean you won't have to check for that on each iteration. You could do this in process, or 'sneakily' in the background while the user is doing something else.
The other thing to try (might help!) is to change the "Do... Loop" block so that you're not checking at the end of each imported row whether or the record is the 'last record'. Instead, get a count of the records, and then compare the current index to the knowm maximum (which might be quicker)
I.E.:
Dim i, x as Integer
i = ActiveDocument.MailMerge.DataSource.RecordCount
Do While x < i
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
x += 1
Loop
I don't really work with the Office Interop much, but hopefully this might offer some assistance! Post back, let me know how it goes.
/Richard.