UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Compare Two Row Of Records For Contigous Days, Access 2016    
 
   
habiler
post Jul 17 2019, 09:16 AM
Post#1



Posts: 67
Joined: 6-August 15



Hello,

I want to add the followed days of a member.
I use the following data

Employee Number] Leave Date_Leave

0002 xyz 01/04/2019
0002 xyz 02/04/2019
0002 xyz 03/04/2019
0002 xyz 10/04/2019
0002 xyz 11/04/2019
0002 abc 27/04/2019
0002 abc 28/04/2019
0002 abc 30/04/2019
0002 xyz 01/05/2019
0003………


Result :

[Employee Number] Leave Date_Leave.Contigous days
0002 xyz 01/04/2019 3
0002 xyz 10/04/2019 2
0002 abc 27/04/2019 2
0002 abc 30/04/2019 1
0002 xyz 01/05/2019 1
0003……...[

I tried with this code but i have an error code 3075 At line
CODE
    Set qdf = db.CreateQueryDef("tempQry2", newSQL)



CODE
Private Sub createQry()
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim qdf As DAO.QueryDef
    Dim newSQL As String

    newSQL = "SELECT Employee_Data.[Employee Number], Employee_Data.[Leave],Employee_Data.[Date_Leave]  (DCount(""Date_Leave"", ""Employee_Data"", ""[Employee Number]="" & ""[Employee Number]"" and Date_Leave=""#"" & Format([Date_Leave] - 1, ""yyyy/dd/mm"") &""#"")) As C "
    newSQL = newSQL + " FROM Employee_Data "
    newSQL = newSQL + " WHERE (((DCount(""Date_Leave"", ""[Employee_Data]"", ""[Employee Number]" & "[Employee Number]  and [Date_Leave]=#"" & Format([[Date_Leave]] - 1, ""mm/dd/yyyy"") & ""#"")) = 0)) "
    newSQL = newSQL + " ORDER BY [Employee_Data].[Employee Number], [Employee_Data].Leave, [Employee_Data].[Date_Leave];"
Debug.Print newSQL
    Set qdf = db.CreateQueryDef("tempQry2", newSQL)

    DoCmd.OpenQuery ("tempQry2")

End Sub
Go to the top of the page
 
RJD
post Jul 17 2019, 01:02 PM
Post#2


UtterAccess VIP
Posts: 9,930
Joined: 25-October 10
From: Gulf South USA


Hi: Actually, just using VBA to create summary records in a new table makes this pretty easy. You might be able to clean up this code a bit, but it works as-is. See the code below and the attached demo db. You can run the Function with F5 and see the results in the new table. And you can add your own error handling if you wish. Let us know if this does what you need.

(Note: This is a slight revision from my original post, dealing with the EOF situation.)

CODE
Public Function ReviseRecords()

Dim db As DAO.Database, rstIn As DAO.Recordset, rstOut As DAO.Recordset
Dim curEmp As String, curLeave As String, curDate As Date, iniDate As Date, DayCount As Long

Set db = CurrentDb
Set rstIn = db.OpenRecordset("Employee_Data")
Set rstOut = db.OpenRecordset("Employee_Data_Revised")

db.Execute "DELETE * FROM Employee_Data_Revised", dbFailOnError

rstIn.MoveFirst

NewGroup:

curEmp = rstIn![Employee Number]
curLeave = rstIn!Leave
curDate = rstIn!Date_Leave
iniDate = rstIn!Date_Leave
DayCount = 1

rstIn.MoveNext

Do Until rstIn.EOF

StartLoop:

If rstIn![Employee Number] = curEmp And rstIn!Leave = curLeave And rstIn!Date_Leave = curDate + 1 Then
            DayCount = DayCount + 1
            curDate = rstIn!Date_Leave
            rstIn.MoveNext
            If rstIn.EOF Then GoTo LastRecord
            GoTo StartLoop
Else
            rstOut.AddNew
            rstOut![Employee_Number] = curEmp
            rstOut!Leave = curLeave
            rstOut!Date_Leave = iniDate
            rstOut!ContiguousDays = DayCount
            rstOut.Update
            
            GoTo NewGroup
End If

Loop

LastRecord:
rstOut.AddNew
rstOut![Employee_Number] = curEmp
rstOut!Leave = curLeave
rstOut!Date_Leave = iniDate
rstOut!ContiguousDays = DayCount
rstOut.Update

End Function


HTH
Joe
Attached File(s)
Attached File  CompareTwoRows.zip ( 23.82K )Number of downloads: 3
 

--------------------
"Each problem that I solved became a rule, which served afterwards to solve other problems."
"You just keep pushing. You just keep pushing. I made every mistake that could be made. But I just kept pushing."

Rene Descartes 1596-1650 (Mathematician and Philosopher)
Go to the top of the page
 
projecttoday
post Jul 18 2019, 07:52 AM
Post#3


UtterAccess VIP
Posts: 10,866
Joined: 10-February 04
From: South Charleston, WV


Have a look at this pseudo-code. If you're outputting to a separate table you can use INSERT.

Dim firsttime as Boolean, lastemployee as string, lasttrandate as date, rs as recordset

Firsttime = true
Set rs = …
Do while not eof(rs)
If not firsttime then
.....If lastemployee <> rs(employee) and lasttrandate = rs(date) + 1
.....Else
..........Output record
.....End if
End if
Firsttime = false
Lasttrandate = rs(trandate)
Lastemployee = rs(employee)
Loop

--------------------
Robert Crouser
Go to the top of the page
 
projecttoday
post Jul 18 2019, 11:48 AM
Post#4


UtterAccess VIP
Posts: 10,866
Joined: 10-February 04
From: South Charleston, WV


Try again:

Dim firsttime as Boolean, lastemployee as string, lasttrandate as date, rs as recordset

Firsttime = true
Set rs = …
Do while not eof(rs)
If firsttime then
.....lastemployee = rs(employee)
.....lasttrandate = rs(trandate)
End If
If lastemployee <> rs(employee) and lasttrandate = rs(trandate) + 1
Else
.....Output record
End if
Firsttime = false
Lasttrandate = rs(trandate)
Lastemployee = rs(employee)
Loop

--------------------
Robert Crouser
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    21st August 2019 - 12:08 AM