I have a badly designed table containing 4 boolean fields, and only one of these 4 fields needs to be true.
ATM i'm just trying to generate random data for testing, but I'm unable to find a way to randomly set one of the four fields to true for 10000 rows.
Is there any pure SQL way to this or should I use some VBA code to do this?
The database I have to use is Microsoft Access.
Thanks for your help!
EDIT - based on Hmax's answer
Private Sub UpdateRandomColumns_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rdm As Integer
Dim tab(1 To 4) As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Data")
'4 columns that need to randomly be updated per row
tab(1) = "TimeOut"
tab(2) = "Interaction"
tab(3) = "Responses"
tab(4) = "Manual"
rs.MoveFirst
Do Until rs.EOF
rs.Edit
rdm = Int((4 - 1 + 1) * Rnd + 1)
rs(aray(rdm)) = True
rs.Update
rs.MoveNext
Loop
MsgBox("Update successful")
End Sub
You can use in your UPDATE SQL a VBA function like this:
Public Function Random1of4(varID As Variant, intIndex As Integer) As Boolean
Static curID As Variant
Static intVal As Integer
If curID <> varID Then
'new id, generate new random number from 1 to 4
intVal = Int(Rnd * 4 + 1)
curID = varID
End If
Random1of4 = intIndex = intVal
End Function
This function uses static variables, which keep values between function calls. It internally generates new random number from 1 to 4 (intVal) and returns True if intIndex parameter is equal to intVal. New intVal generated if parameter varID changed.
Create this function in standard module, then create and run UPDATE statement with this function - pass to varID any value from table, which is different for every row (normally primary key) and to intIndex a number from 1 to 4 for each of boolean fields:
UPDATE Data
SET TimeOut = Random1of4([ID], 1)
,Interaction = Random1of4([ID], 2)
,Responses = Random1of4([ID], 3)
,Manual = Random1of4([ID], 4);
Related
I've been asked to make a change to a VB6 project. The issue I'm having is that I'm trying to get some data from an Access database and assign the data to some variables.
I've got the code:
Dta_Period.DatabaseName = DB_Accounts_Name$
Dta_Period.RecordSet = "SELECT * FROM [Period]"
Dta_Period.Refresh
The table Period contains 2 fields. sMonth and Period
The sMonth field contains the months January - December. The Period field stores a number 0 to 11, to represent what number has been assigned to which month in the customers financial year. January may be 0, or may be 11, essentially.
I need to know which month goes with which period, which is why I have selected this data from the database. However, I'm stuck with what to do next.
How can I loop over the RecordSet (If this is even possible?) and find out what number has been assigned to each month?
I don't think there is a way I can use a Do Until loop. Is it easier to just use 12 separate queries, and then create an array of strings and an array of integers and then loop over the array of strings until I find the correct month, the use the same index for the array on integers?
EDIT 1
To make things simpler to follow for both myself and anyone attempting to provide an answer, I have modified the code.
Dim rstPeriod As DAO.RecordSet
Dim accDB As DAO.Database
' DB_Session is a Workspace, whilst DB_Accounts_Name$ is the name of the DB I am using
Set accDB = DB_Session.OpenDatabase(DB_Accounts_Name$)
SQL = "SELECT * FROM [Period] ORDER BY [Period]"
Set rstPeriod = accDB.OpenRecordset(SQL, dbOpenDynaset)
If rstPeriod.BOF = False Then
rstPeriod.MoveFirst
End If
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Pseudocode idea:
Do Until rstPeriod.EOF
Select Case currentRow.Field("Month")
Case "January"
strMonth(0) = "January"
pNumber(0) = currentRow.Field("Number")
Case "February"
strMonth(1) = "February"
pNumber(1) = currentRow.Field("Number")
End Select
Loop
Loop through recordset and fill the arrays with the month name and month number.
This assumes the recordset returns no more than 12 records.
Public Sub LoopThroughtRecordset()
On Error GoTo ErrorTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM [Period] ORDER BY [Period]", dbOpenSnapShot)
With rs
If .EOF Then GoTo Leave
.MoveLast
.MoveFirst
End With
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Dim idx As Long
For idx = 0 To rs.RecordCount -1
strMonth(idx) = rs![Month]
pNumber(idx) = rs![Number]
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, CurrentDb.Properties("AppTitle")
Resume Leave
End Sub
'strMonth(0) = January
'strMonth(1) = February
'...
'pNumber(0) = 1
'pNumber(1) = 2
'...
In a query I have an SQL iif statement that incorporates too many iif, therefore I cannot add any more iif, which is a problem.
To solve the problem, I had the idea to code a VBA function, but I am facing difficulties. Here is what I have, with a simple example where we have a Number in a field. In case the number is <0, the function Retrive() should retrieve the value of field TheDate, in case >0 the function should retrieve the value of the field TheOtherDate:
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
End If
r.MoveNext
Next i
End Function
But this does not work because it retrieves the last record for each line, not the right lines.
Your For loop just keeps running until you reach the last record and then exits. You have to jump out of the loop when you reach the correct record (you decide how to determine this).
Option Explicit
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim TheRightDate As Date
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
TheRightDate = DateValue("1/15/2015")
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
r.MoveNext
Next i
End Function
So I have the following code in Access:
Dim db As DAO.Database
Dim qdEPH As DAO.QueryDef
Dim rsEPH As DAO.Recordset
Set qdEPH = DBEngine(0)(0).QueryDefs("MyQuery")
qdEPH.Parameters(0) = Text10.Value
Set db = CurrentDb
Set rsEPH = qdEPH.OpenRecordset
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets("Sheet1")
oSheet.Activate
Dim Count as Long
Count = 1
Do While Not rsEPH.EOF
oSheet.Range("A" & Count).Value = rsEPH("Value1")
Count = Count + 1
rsEPH.MoveNext
Loop
A user puts a value in textbox Text10 on a form and clicks a button to run the code above. It runs the query MyQuery and dumps the results into a recordset named rsEPH. One of the fields, Value1, is stored as a text value in the table being queried. However, it's actually a number. How can I convert rsEPH("Value1") to a number (returning Null or something if it fails) and then divide it by 100?
Use Nz to transform Nulls in the text field before you apply the numeric conversion function. I chose CDbl as the conversion function.
oSheet.Range("A" & Count).Value = CDbl(Nz(rsEPH("Value1"), "0"))
But you mentioned dividing by 100, so maybe you want this ...
oSheet.Range("A" & Count).Value = CDbl(Nz(rsEPH("Value1"), "0")) / 100
Try below code
Do While Not rsEPH.EOF
oSheet.Range("A" & Count).Value = IIf(IsNull(rsEPH("Value1")), 0, CDbl(rsEPH("Value1")))
Count = Count + 1
rsEPH.MoveNext
Loop
hi guys im trying to take the value of data(0)
and put it into say variable InvoiceNumber. I tried putting an image of my watch screen but i ended up not being allow. but here is what my watch screen would look like.
data
data(0)
data(0,1) 1
data(0,2) 2
data(0,3) 3
I have tried
dim InvoiceNumber as variant <br/>
invoiceNumber = data(0)
but i keep getting error. I dont know how to reference just the part of that array. any help would be greatly appreciated.
here is the full code for anyone that would like to see a little more.
Dim db As Database
Dim rs As Recordset
Dim data As Variant
Dim colummn1 As Variant
Dim obj As Object
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from Table1")
'set obj = new object
While Not rs.EOF
'MsgBox (rs.RecordCount)
'MsgBox (rs.Fields.Count)
data = rs.GetRows(rs.Fields.Count)
Column1 = data.data(0)
Wend
rs.Close
db.Close
End Sub
Try
Column1 = data(0,0)
instead of
Column1 = data.data(0)
data contains a two-dimensional array. The fist index is the field number, the second index is the row number. Both start at zero. So data(0,0) is the first field of the first row. data(1,0) is the second field of the first row.
I would try to make an array of invoices by using a user defined type
Public Type Invoice
Nr As Variant
IssueDate As Variant
Total As Variant
'Or whatever your invoice contains
End Type
Public Sub TestGetRecords()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim data As Variant
Dim numRecords As Long, i As Long
Dim Invoices() As Invoice
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from Table1")
data = rs.GetRows()
rs.Close
db.Close
numRecords = UBound(data, 2) + 1
ReDim Invoices(0 To numRecords - 1) As Invoice
For i = 0 To numRecords - 1
Invoices(i).Nr = data(0, i)
Invoices(i).IssueDate = data(1, i)
Invoices(i).Total = data(2, i)
Next i
Debug.Print Invoices(0).Total
End Sub
An error in you solution is, that you placed GetRows in a loop. However, GetRows returns all the rows at once!
I am finding it a little hard to understand what you are trying to achieve.
You are reading an entire table of data into a recordset object, loading the fields of the recordset object into a two dimensional array and then trying to iterate through the array to output the results to a single variable (or a sum of array values).
Why don't you just use an SQL expression to extract the data directly from your table?
If we can assume you have a table of invoices (say ... "myInvoiceTable") with at least the following fields ...
invoiceID
invoiceValue
(and probably many others, eg. invoiceDate, clientID, etc.)
you can write an expression something like this
"SELECT SUM(invoiceValue) AS MyTotal FROM myInvoiceTable WHERE invoiceID > xxxx"
This might go into your VBA code like this.
Dim rst as Recordset
Dim strSQL as string
strSQL = "SELECT SUM(invoiceValue) AS MyTotal FROM myInvoiceTable WHERE invoiceID > 400" '-- use an appropriate WHERE clause if needed
Set rst = CurrentDb.Openrecordset(strSQL) '-- the rst object should contain a single value "MyTotal" which is the sum of the fields you are trying to access
MsgBox rst!MyTotal '-- use this value wherever you need to use it
I'm assigning an Access 2007 query to a QueryDef in Excel VBA. My query calls a user-defined function, because it performs a calculation on the results of evaluating a field with a regular expression. I'm using a QueryDef because I'm collecting values in a UserForm and want to pass them to the query as parameters.
When I run my VBA code, I get an error: "Run-time error '3085': Undefined function 'regexFunc' in expression."
This question suggests that the problem is that DAO is unable to call Access UDFs from Excel, so I copied my UDF into the Excel VBA module, but I still get the error.
Access query:
select field1 from dataTable where regexFunc(field1)=[regexVal]
Here's the Excel VBA code:
'QueryDef function
Sub makeQueryDef (str As String)
Dim qdf As QueryDef
Dim db As Database
Set db = OpenDatabase(DBpath)
Set qdf = db.QueryDefs("paramQuery")
qdf.Parameters("regexVal") = (str="test")
doSomething qdf
End Sub
'Regex function copied from Access VBA module to Excel VBA module
Function regexFunc(str As String) As Boolean
Dim re As RegExp
Dim matches As MatchCollection
regexFunc = False
Set re = New RegExp
re.Pattern = "\reg[ex](pattern)?"
Set matches = re.Execute(str)
If matches.Count <> 0 Then
regexFunc = True
End If
End Function
This is how I would do it... just tested it and it works fine with my UDF:
One thing - are you required to not use New Access.Application?
Sub GetMyDataWithUDF()
Dim oApp As Access.Application
Dim qd As QueryDef
sFileName = "C:\Users\AUser\Desktop\adatabase.mdb"
Set oApp = New Access.Application
oApp.OpenCurrentDatabase (sFileName)
Set qd = oApp.CurrentDb.QueryDefs("Query1")
If oApp.DCount("*", "MSysObjects", "Name='dataTableResults'") > 0 Then _
oApp.CurrentDb.TableDefs.Delete "dataTableResults"
qd.Parameters("avalue") = "4"
qd.Execute
oApp.Quit
Set oApp = Nothing
Dim oRS As ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFileName & ";User Id=admin;Password=;"
Set oRS = New ADODB.Recordset
oRS.Open "SELECT * FROM dataTableResults", sConn
Sheet1.Cells.Clear
Sheet1.Range("A1").CopyFromRecordset oRS
oRS.Close
Set oRS = Nothing
End Sub
Note that I made my underlying query a SELECT ... INTO query that creates a table called 'dataTableResults'
This is my query (QueryDef) in Access:
SELECT dataTable.Field1, dataTable.Field2 INTO dataTableResults
FROM dataTable
WHERE mysqr(dataTable.Field1)=[avalue];
My MS-Access DB has a function called "mysqr", which gets used in the SQL above.
Function mysqr(Num)
mysqr = Num * Num
End Function
The table "dataTable" I'm querying against is just a list of numbers, so if my parameter "avalue" is "16", then I get the row "4" back. If I enter "4" (as in my code), I get "2" back.
I've solved this. Here's how I did it.
First I change the query into a recordset and pass it to my filtering function:
function filteredQDF(qdf As QueryDef, boolVal As Boolean) As Variant
Dim rs As Recordset
Dim rows_rs As Variant
Dim rs_new As Recordset
Dim filtered As Variant
Set rs = qdf.OpenRecordset
rs.MoveLast
rs.MoveFirst
rows_rs = rs.GetRows(rs.RecordCount)
rows_rs = Application.WorksheetFunction.Transpose(rows_rs)
filtered = filterFunction(rows_rs, boolVal)
filteredQDF = filtered
End Function
And here's the filtering function, which creates a new array, populates it with rows that pass the UDF's boolean check, and returns it:
Function filterFunction(sourceArray As Variant, checkValue As Boolean) As Variant
Dim targetArray As Variant
Dim cols As Long
Dim targetRows As Long
Dim targetCursor As Long
'get # of columns from source array
cols = UBound(sourceArray, 2)
'count total number of target rows because 2D arrays cannot Redim Preserve
'checking sourceArray(r,2) because that's the criterion column
targetRows = 0
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
targetRows = targetRows + 1
End If
Next
'set minimum target rows to 1 so that function will always return an array
If targetRows = 0 Then
targetRows = 1
End If
'redim target array with target row count
ReDim targetArray(targetRows, cols)
'set cursor for assigning values to target array
targetCursor = 0
'iterate through sourceArray, collecting UDF-verified rows and updating target cursor to populate target array
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
For c = 1 To cols
targetArray(targetCursor, c - 1) = sourceArray(r, c)
Next
targetCursor = targetCursor + 1
End If
Next
'assign return value
filterFunction = targetArray
End Function