Solved Consolidate Employee Time In/Out take time to load.

[atzdgreat]

TABLE: Table_Test

OBJECTIVE: to consolidate employee according to their time in, time out, and roster type.

RESULT:

EXPLANATION:

1. If Employee was not on leave nor late nor early out. The Rostered Type to be retrieved is always Start and End.
2. If Employee was Late. The Rostered Type to be retrieved for TapIn is Leave: Late and for TapOut is Leave: End and Remarks will be Late.
3. If Employee was Late and Early Out. The Rostered Type to be retrieved for TapIn is Leave: Late and TapOut is Leave: End and Remarks will be Late/EO.
4. If Employee was on Leave. The Rostered to be retrieved for TapIn is Leave: PLV and for TapOut is Leave: End and Remarks will be PLV.

CODE:

    Dim db As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim rs1 As ADODB.Recordset
    Dim TapIn, TapOut, ToEnd, Remarks As String
    Dim Arr() As String
    Dim dbName
    
    dbName = "C:\Test\Db Test.accdb"
    sConnString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbName & ";Jet OLEDB:Database Password="
    Set db = New ADODB.Connection
    
    If Not db Is Nothing Then
        If (db.State And adStateOpen) = adStateOpen Then
        Else
            db.Open (sConnString)
            db.CommandTimeout = 0
        End If
    End If
    
    MYSQL = "SELECT DISTINCT EmpID, RosteredDate FROM Table_Test"
    Set rs = New ADODB.Recordset
    rs.Open MYSQL, db, adOpenKeyset, adLockOptimistic
    
    If rs.EOF Then
    Else
        Do Until rs.EOF = True
            MYSQL = "SELECT * FROM Table_Test WHERE EmpID = '" & rs.Fields("EmpID") & "' AND RosteredDate = '" & rs.Fields("RosteredDate") & "'"
            Set rs = New ADODB.Recordset
            rs1.Open MYSQL, db, adOpenKeyset, adLockOptimistic
            
            TapIn = ""
            TapOut = ""
            Remarks = ""
            ToEnd = ""
            If rs1.EOF Then
            Else
                Do Until rs1.EOF = True
                    If Not InStr(1, rs1.Fields("RosteredType"), "End", vbTextCompare) > 0 Then
                        If InStr(1, rs1.Fields("RosteredType"), "Leave:", vbTextCompare) > 0 Then
                            Arr = Split(rs1.Fields("RosteredType"), ":")
                            If Remarks = "" Then
                                Remarks = Trim(Arr(1))
                            Else
                                Remarks = Remarks & "/" & Trim(Arr(1))
                            End If
                        End If
                    
                        If InStr(1, rs1.Fields("RosteredType"), "Start", vbTextCompare) > 0 Or InStr(1, rs1.Fields("RosteredType"), "Leave:", vbTextCompare) > 0 Then
                            TapIn = rs1.Fields("RosteredTime")
                        End If
                    Else
                        If InStr(1, rs1.Fields("RosteredType"), "End", vbTextCompare) > 0 Then
                            TapOut = rs1.Fields("RosteredTime")
                        End If
                    End If
                    rs1.MoveNext
                Loop
            End If
            
            rs1.Close
            Set rs1 = Nothing
            
            rs.MoveNext
        Loop
    End If
    
    rs.MoveNext
    Set rs = Nothing
    
    db.Close
    Set db = Nothing

PROBLEM: Once Record has too many, it takes sometime to load

 

[CJ_London]

why use ado? Manipulating large amounts of data using recordsets will always be slow

The meaning of your data needs some clarification - every day has a start and end record and ending at 18:36 every day seems very specific- are these records effectively ‘roster’ records? i.e. a standard day and you don’t care if the user left at 18:50?

 

[arnelgp]

qryFinal will give you the result (using VBA).
use frmFinal (datasheet) so that the dictionary object is reset, when there is change in records).

 

[atzdgreat]

qryFinal will give you the result (using VBA).
use frmFinal (datasheet) so that the dictionary object is reset, when there is change in records).

Thank you for your answer