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);
I have a table with Name as MyTable which has field Names(TEXT) which has values, 'MFG##', 'jkl%980', I have written a function to remove special character like this
Function fn_RemoveSpecialChars(strText As String) As Boolean
Dim db As DAO.Database
Set db = CurrentDb()
Dim output As String
Dim c
Dim i As Integer
For i = 1 To Len(strText)
c = Mid(strText, i, 1)
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c
Else
output = output & ""
End If
Next
fn_RemoveSpecialChars = LTrim(RTrim(output))
End Function`
I am using command click to utilize function to update in MyTable like this
Private Sub Command0_Click()
Dim db As DAO.Database
Set db = CurrentDb()
db.Execute "Update MyTable set Names=fn_RemoveSpecialChars(Names)"
End Sub
If i use the same function as module then it works fine for me, But if i use like a function shown above then it won't work, May be because UPDATE is DML Operation. Because of some user requirement i can't use Modules or procedures, So Is there any alternate way to achieve above ?, Any help would be greatly appreciated.
Input : MFG##$123
Output: MFG123
Your function returns the wrong data type - it must be string, not boolean.
Function fn_RemoveSpecialChars(strText As String) As String
I am trying to use this code to pick comma seperated numbers from ExcUID text box of form and then feed them into tblExcIndivList table.
However what I am trying to do it to split ex: 123,1213 into lines and put them in seperate rows of UID column of tblExcIndivList table but it gets saved as 1231213 in the same cell.
Sub Upd_UID()
Dim var As Variant
Dim i As Long
var = Split(Forms.Agen_Report.ExcUID.Value, vbNewLine)
CurrentDb.Execute "DELETE * FROM tblExcIndivList;", dbFailOnError
For i = 0 To UBound(var)
CurrentDb.Execute Replace("INSERT INTO tblExcIndivList ( UID ) VALUES ( '#V' );", "#V", var(i)), dbFailOnError
Next i
End Sub
Please help.
You are not splitting correctly your string, you say it is comma-separated (i.e. 123,1213) and try to split it with vbNewLine. You should specify the comma as separator:
var = Split(Forms.Agen_Report.ExcUID.Value, ",")
This will get you past this error and split correctly the input. However I cant make sure whether your query is well-formed.
I think you need something like this.
Option Explicit
Dim aCell As Range
Private Sub UserForm_Initialize()
'~~> Change Sheet1 to the relevant sheet name
'~~> Change A1:E1 to the relevant range
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
ComboBox1.AddItem Split(aCell.Value, ",")(0)
Next aCell
'~~> Remove duplicates
RemoveDuplicates ComboBox1
End Sub
Private Sub ComboBox1_Click()
Dim tmpStr As String
ComboBox2.Clear
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
tmpStr = Split(aCell.Value, ",")(0)
If Trim(ComboBox1.Value) = Trim(tmpStr) Then _
ComboBox2.AddItem aCell.Value
Next aCell
End Sub
'~~> Procedure to remove duplicates
Private Sub RemoveDuplicates(cmb As ComboBox)
Dim a As Integer, b As Integer, c As Integer
a = cmb.ListCount - 1
Do While a >= 0
For b = a - 1 To 0 Step -1
If cmb.List(b) = cmb.List(a) Then
cmb.RemoveItem b
a = a - 1
End If
Next b
a = a - 1
Loop
End Sub
I have a stupid question, I always got the error type mismatch when I created a function which return a array. here are two simple example :
if I don't declare the type when declaration: It will be compiled, but got the error after the function result
Function aa(c As Integer)
Dim arr(10)
Dim i As Integer
Dim k As Double
For i = 0 To 10
k = i ^ 2 / c + 1
arr(i) = CStr(k)
Debug.Print k
Next i
aa = arr
End Function
if i declare the type: it can't be compiled and will get the error directly
Function aa(c As Integer) as string()
Dim arr(10) as string
Dim i As Integer
Dim k As Double
For i = 0 To 10
k = i ^ 2 / c + 1
arr(i) = CStr(k)
Debug.Print k
Next i
aa = arr
End Function
Your second version will work if you call it this way, using the same type:
Sub Testaa()
Dim result() As String
result = aa(4)
End Sub
Your first version will return a Variant - any function (or variable) that isn't given a specific type will default to Variant. So you need to store the return result in a Variant as well:
Sub Testaa()
Dim result As Variant
result = aa(4)
End Sub
It is preferable to use explicit types wherever possible.
I am trying to import a comma delimted csv file in access. The issue i am having is that one of the columns "Amount" has commas in the data itself e.g. "1,433.36". And there will always be commas in this data.
How can I import is successfully?
Sample Data:
sjonn,one,"1,855.9"
ptele,two,344.0
jrudd,one,334.8
Thanks in advance
I would change the delimiter to a different character, like a pipe "|".
if the DoCmd.TransferText does not work for you, then you can define a method to do that 'manually' :
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Set objFile = fs.GetFile("import.txt")
Set objFileTextStream = objFile.OpenAsTextStream(1, 2)
objFileTextStream.skipLine 'if the file contains the header
Do While objFileTextStream.AtEndOfStream <> True
strLine = objFileTextStream.ReadLine 'read a line
strLinePart = split(strLine,",") 'Split the line using the , delimiter
firstField = strLinePart(0)
secondField = strLinePart(1)
thirdField = strLinePart(2)
strSQL = "INSERT INTO myTable Values('"& firstField &"','"& secondField &"','"& thirdField &"')"
conn.Execute strSQL
Loop
objFileTextStream.Close: Set objFileTextStream = Nothing
Set fs = Nothing
conn.Close: Set conn = Nothing
Save the file as a tab delimited text file and import that instead.
reading the file using input handles the quotes for you
Dim f1 As String
Dim f2 As String
Dim f3 As String
Open "d:\test.txt" For Input As #1
Input #1, f1, f2, f3
Debug.Print f1, f2, f3
Input #1, f1, f2, f3
Debug.Print f1, f2, f3
Close #1 '
giving
sjonn one 1,855.9
ptele two 344.0
I once encountered the problem and this is another method that might help, it however splits the lines themselves, i.e. you must split the string first into lines before using this method
Its also assumed that its contained in a Module named Module1
''Perfoms a smart split that takes care of the ""
Public Function SmartSplit(Str As String) As Variant
''New collection
Dim Quote As String
Dim Delimiter As String
Dim MyString As String
Dim Sample As String
Dim StrCollection As New Collection
Dim Array_1() As String
Dim HasSeenQuote As Boolean
Dim index As Long
Quote = "" & CStr(Chr(34))
Delimiter = "" & CStr(Chr(44))
HasSeenQuote = False
Array_1 = Split(Str, Delimiter)
For index = LBound(Array_1) To UBound(Array_1)
Sample = Array_1(index)
If Module1.StartsWith(Sample, Quote, False) Then
HasSeenQuote = True
End If
''We append the string
If HasSeenQuote Then
MyString = MyString & "," & Sample
End If
''We add the term
If Module1.EndsWith(Sample, Quote, False) Then
HasSeenQuote = False
MyString = Replace(MyString, Quote, "")
MyString = Module1.TrimStartEndCharacters(MyString, ",", True)
MyString = Module1.TrimStartEndCharacters(MyString, Quote, True)
StrCollection.Add (MyString)
MyString = ""
GoTo LoopNext
End If
''We did not see a quote before
If HasSeenQuote = False Then
Sample = Module1.TrimStartEndCharacters(Sample, ",", True)
Sample = Module1.TrimStartEndCharacters(Sample, Quote, True)
StrCollection.Add (Sample)
End If
LoopNext:
Next index
''Copy the contents of the collection
Dim MyCount As Integer
MyCount = StrCollection.Count
Dim RetArr() As String
ReDim RetArr(0 To MyCount - 1) As String
Dim X As Integer
For X = 0 To StrCollection.Count - 1 ''VB Collections start with 1 always
RetArr(X) = StrCollection(X + 1)
Next X
SmartSplit = RetArr
End Function
''Returns true of false if the string starts with a string
Public Function EndsWith(ByVal Str As String, Search As String, IgnoreCase As Boolean) As Boolean
EndsWith = False
Dim X As Integer
X = Len(Search)
If IgnoreCase Then
Str = UCase(Str)
Search = UCase(Search)
End If
If Len(Search) <= Len(Str) Then
EndsWith = StrComp(Right(Str, X), Search, vbBinaryCompare) = 0
End If
End Function
''Trims start and end characters
Public Function TrimStartEndCharacters(ByVal Str As String, ByVal Search As String, ByVal IgnoreCase As Boolean) As String
If Module1.StartsWith(Str, Search, IgnoreCase) Then
Str = Right(Str, (Len(Str) - Len(Search)))
End If
If Module1.EndsWith(Str, Search, IgnoreCase) Then
Str = Left(Str, (Len(Str) - Len(Search)))
End If
TrimStartEndCharacters = Str
End Function
''Returns true of false if the string starts with a string
Public Function StartsWith(ByVal Str As String, Search As String, IgnoreCase As Boolean) As Boolean
StartsWith = False
Dim X As Integer
X = Len(Search)
If IgnoreCase Then
Str = UCase(Str)
Search = UCase(Search)
End If
If Len(Search) <= Len(Str) Then
StartsWith = StrComp(Left(Str, X), Search, vbBinaryCompare) = 0
End If
End Function