By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,985 Members | 2,884 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,985 IT Pros & Developers. It's quick & easy.

VBA Access date time

P: 4
I am new to VBA Access. I create "mytable" with 2 columns from existing main table by giving start date and end date.
Given below is mytable.
First column: dt( date hr:min:sec format )
Second column: string( the row elements could be true or false or none )
dt string
3/4/04 1:05:30 PM true
3/4/04 1:06:39 PM false
3/5/04 1:06:42 PM false
3/5/04 1:07:40 PM none
3/5/04 1:08:00 AM false
3/5/04 1:08:10 PM false
3/5/04 1:24:20 PM false
3/5/04 1:34:20 PM false
3/6/04 1:36:30 PM true
In the string column, the VBA code should look for "false". Look for a pattern where false is in continuous order like ( false2, false3 )
or (false5, false6, false7, false8) and increment the counter if the time difference (false3 - false2)>=180seconds or (false7-false5)>=180
or (false8 - false5)>= 180.
The output should give final value of counter and p = (counter/num)*100
In the above case, the output will be counter=3 because of (false6 - false5) ( false7 - false5 ) and (false8 - false5) and value of
p=(3/num)*100
num = datediff(false8 - false5)
Note: false2 means 2nd element in string column is false.If it would have been false5, false6 and false7 and then true8 then the counter should increment if (false7-false5)>=180seconds.

Output should be

Date counter p
3/4/04 0 0
3/5/04 3 (3/num)*100
3/6/04 0 0
If someone can give the VBA code that will be great.
Thanks in advance.
Oct 24 '06 #1
Share this Question
Share on Google+
6 Replies


MMcCarthy
Expert Mod 10K+
P: 14,534
OK try this. I'm not sure if I've caught all the logic but we'll see.

In the VB Editor window go to tools - references on the menu bar and make sure there is a Microsoft DAO library ticked.

In mytable change the field name string to myStr

Create a new table called myNewTable with fields; newDate, counter, p

Expand|Select|Wrap|Line Numbers
  1.  
  2. Function falseStats()
  3. Dim db As Database
  4. Dim rs As DAO.Recordset
  5. Dim strSQL As String
  6. Dim tempDate As Date
  7. Dim NoOfDays As Integer
  8. Dim tempValue As String
  9. Dim NoOfSeconds As Integer
  10. Dim counter As Integer
  11. Dim result As Boolean
  12.  
  13.  strSQL="SELECT * FROM mytable ORDER BY dt;"
  14.  
  15.  Set db = CurrentDb
  16.  Set rs = db.OpenRecordset(strSQL)
  17.  rs.MoveFirst
  18.  Do until rs.EOF
  19.   result = True
  20.   tempDate = rs!dt,
  21.   tempValue = rs!myStr
  22.   NoOfSeconds=0
  23.   counter=0
  24.   If tempValue = "false" Then 'first record false
  25.    do until result=False   'repeat while false in value
  26.     rs.MoveNext
  27.     If rs!myStr = "false" Then 'next record is false
  28.      NoOfSeconds=DateDiff ('s', tempDate, rs!dt)
  29.      NoOfDays=DateDiff('d', tempDate, rs!dt)
  30.      If NoOfSecond >=180 Then
  31.       counter=counter+1
  32.      End If
  33.     Else
  34.      rs.MovePrev
  35.      DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) " & _
  36.                    "VALUES (Format(rs!dt,"Short Date"), counter, (counter/NoOfDays)*100);")
  37.      result=False
  38.     End If
  39.    loop
  40.   Else
  41.    DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) VALUES (Format(rs!dt,"Short Date"), 0, 0);")
  42.   End If
  43.   rs.MoveNext
  44.  Loop
  45.  
  46.  rs.Close
  47.  Set rs = Nothing
  48.  Set db = Nothing
  49.  
  50. End Function
  51.  
  52.  
Oct 25 '06 #2

P: 4
OK try this. I'm not sure if I've caught all the logic but we'll see.

In the VB Editor window go to tools - references on the menu bar and make sure there is a Microsoft DAO library ticked.

In mytable change the field name string to myStr

Create a new table called myNewTable with fields; newDate, counter, p

Expand|Select|Wrap|Line Numbers
  1.  
  2. Function falseStats()
  3. Dim db As Database
  4. Dim rs As DAO.Recordset
  5. Dim strSQL As String
  6. Dim tempDate As Date
  7. Dim NoOfDays As Integer
  8. Dim tempValue As String
  9. Dim NoOfSeconds As Integer
  10. Dim counter As Integer
  11. Dim result As Boolean
  12.  
  13.  strSQL="SELECT * FROM mytable ORDER BY dt;"
  14.  
  15.  Set db = CurrentDb
  16.  Set rs = db.OpenRecordset(strSQL)
  17.  rs.MoveFirst
  18.  Do until rs.EOF
  19.   result = True
  20.   tempDate = rs!dt,
  21.   tempValue = rs!myStr
  22.   NoOfSeconds=0
  23.   counter=0
  24.   If tempValue = "false" Then 'first record false
  25.    do until result=False   'repeat while false in value
  26.     rs.MoveNext
  27.     If rs!myStr = "false" Then 'next record is false
  28.      NoOfSeconds=DateDiff ('s', tempDate, rs!dt)
  29.      NoOfDays=DateDiff('d', tempDate, rs!dt)
  30.      If NoOfSecond >=180 Then
  31.       counter=counter+1
  32.      End If
  33.     Else
  34.      rs.MovePrev
  35.      DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) " & _
  36.                    "VALUES (Format(rs!dt,"Short Date"), counter, (counter/NoOfDays)*100);")
  37.      result=False
  38.     End If
  39.    loop
  40.   Else
  41.    DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) VALUES (Format(rs!dt,"Short Date"), 0, 0);")
  42.   End If
  43.   rs.MoveNext
  44.  Loop
  45.  
  46.  rs.Close
  47.  Set rs = Nothing
  48.  Set db = Nothing
  49.  
  50. End Function
  51.  
  52.  

Statements given below give errors.
tempDate = rs!dt, ( error because of comma )

result=False ( Error is False not defined)

NoOfSeconds=DateDiff ('s', tempDate, rs!dt) '( This is in red )

NoOfDays=DateDiff('d', tempDate, rs!dt) '( This is in red )


DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) " & _
"VALUES (Format(rs!dt,"Short Date"), counter, (counter/NoOfDays)*100);") '( This is in red )


DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) VALUES (Format(rs!dt,"Short Date"), 0, 0);") '( This is in red )

Please advise.
Thanks
Oct 25 '06 #3

NeoPa
Expert Mod 15k+
P: 31,492
False not defined implies you have some library missing.
In the VBA debugger go to Tools / References... and see which are ticked
I thought False was a built-in constant so should be in the 'Visual Basic for Applications' library.

The others all seem to be ok (to me).
If they show as red in the debugger, try deleting them and re-entering them and note the error message. That might give a clue.
If it says the functions are not defined then that again is a library issue.
Oct 25 '06 #4

MMcCarthy
Expert Mod 10K+
P: 14,534
Ok should all work now:

Expand|Select|Wrap|Line Numbers
  1.  
  2. Function falseStats()
  3. Dim db As Database
  4. Dim rs As DAO.Recordset
  5. Dim strSQL As String
  6. Dim tempDate As Date
  7. Dim NoOfDays As Integer
  8. Dim tempValue As String
  9. Dim NoOfSeconds As Integer
  10. Dim counter As Integer
  11. Dim rslt As Boolean
  12.  
  13.     strSQL = "SELECT * FROM mytable ORDER BY dt;"
  14.  
  15.     Set db = CurrentDb
  16.     Set rs = db.OpenRecordset(strSQL)
  17.     rs.MoveFirst
  18.     Do Until rs.EOF
  19.         rslt = True
  20.         tempDate = rs!dt
  21.         tempValue = rs!myStr
  22.         NoOfSeconds = 0
  23.         counter = 0
  24.         If tempValue = "false" Then 'first record false
  25.         Do Until rslt = False 'repeat while false in value
  26.             rs.MoveNext
  27.             If rs!myStr = "false" Then 'next record is false
  28.                 NoOfSeconds = DateDiff("s", tempDate, rs!dt)
  29.                 NoOfDays = DateDiff("d", tempDate, rs!dt)
  30.                 If NoOfSeconds >= 180 Then
  31.                     counter = counter + 1
  32.                 End If
  33.             Else
  34.                 rs.MovePrevious
  35.                 DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) " & _
  36.                           "VALUES (Format(rs!dt,'Short Date'), counter, (counter/NoOfDays)*100);")
  37.                 rslt = False
  38.             End If
  39.         Loop
  40.     Else
  41.         DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) VALUES (Format(rs!dt,'Short Date'), 0, 0);")
  42.     End If
  43.     rs.MoveNext
  44.     Loop
  45.  
  46.  rs.Close
  47.  Set rs = Nothing
  48.  Set db = Nothing
  49.  
  50. End Function
  51.  
  52.  
Oct 25 '06 #5

P: 4
Ok should all work now:

Expand|Select|Wrap|Line Numbers
  1.  
  2. Function falseStats()
  3. Dim db As Database
  4. Dim rs As DAO.Recordset
  5. Dim strSQL As String
  6. Dim tempDate As Date
  7. Dim NoOfDays As Integer
  8. Dim tempValue As String
  9. Dim NoOfSeconds As Integer
  10. Dim counter As Integer
  11. Dim rslt As Boolean
  12.  
  13.     strSQL = "SELECT * FROM mytable ORDER BY dt;"
  14.  
  15.     Set db = CurrentDb
  16.     Set rs = db.OpenRecordset(strSQL)
  17.     rs.MoveFirst
  18.     Do Until rs.EOF
  19.         rslt = True
  20.         tempDate = rs!dt
  21.         tempValue = rs!myStr
  22.         NoOfSeconds = 0
  23.         counter = 0
  24.         If tempValue = "false" Then 'first record false
  25.         Do Until rslt = False 'repeat while false in value
  26.             rs.MoveNext
  27.             If rs!myStr = "false" Then 'next record is false
  28.                 NoOfSeconds = DateDiff("s", tempDate, rs!dt)
  29.                 NoOfDays = DateDiff("d", tempDate, rs!dt)
  30.                 If NoOfSeconds >= 180 Then
  31.                     counter = counter + 1
  32.                 End If
  33.             Else
  34.                 rs.MovePrevious
  35.                 DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) " & _
  36.                           "VALUES (Format(rs!dt,'Short Date'), counter, (counter/NoOfDays)*100);")
  37.                 rslt = False
  38.             End If
  39.         Loop
  40.     Else
  41.         DoCmd.RunSQL ("INSERT INTO myNewTable (newDate, Counter, p) VALUES (Format(rs!dt,'Short Date'), 0, 0);")
  42.     End If
  43.     rs.MoveNext
  44.     Loop
  45.  
  46.  rs.Close
  47.  Set rs = Nothing
  48.  Set db = Nothing
  49.  
  50. End Function
  51.  
  52.  
I apologize for the late reply. But when I run the code, it asks for parameters( I dont want that way ). Please advise.
Oct 31 '06 #6

NeoPa
Expert Mod 15k+
P: 31,492
Which parameters does it ask for?
Oct 31 '06 #7

Post your reply

Sign in to post your reply or Sign up for a free account.