FIRST and the LAST time readings from the daily card readings and ignoring the ones in between

pulsarkuant · Feb 18, 2022

We are using the attached excel to log Staff START and end times. We have logs from the card readers and basically copying the raw logs to the "Raw Data" sheet and hitting the CommadnButton to distribute to the staff listed in the "Personel" sheet. It works fine, but I want to only pick the very FIRST and the LAST reading during each day and ignore any readings in between. How can I tell the below code to pick the first and the last reading?

##The command button on the "Raw Data" sheet has the below VB code and attached an image.

VBA Code:

Private Sub CommandButton1_Click()

Dim irow As Long
 
 Application.ScreenUpdating = False
 With ActiveSheet
    For irow = .Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
        If UCase(.Cells(irow, 2)) Like "*ADMINDOOR*" Or _
            UCase(.Cells(irow, 2)) Like "*LIFT*" Or _
            UCase(.Cells(irow, 2)) Like "*CANTEEN*" Or _
             UCase(.Cells(irow, 2)) Like "*GATE*" Then
            .Rows(irow).Delete
        End If
    Next
 End With
 Application.ScreenUpdating = True

 
For a = 3 To Sheets("Personel").Cells(65000, 1).End(xlUp).Row
For b = 1 To Sheets("Raw data").Cells(65000, 1).End(xlUp).Row
 c = Len(Sheets("Personel").Cells(a, 1))
 If Left(Cells(b, 2), c) = Sheets("Personel").Cells(a, 1) Then
 d = Day(Cells(b, 1)) * 2
 If Hour(Cells(b, 1)) > 11 Then d = d + 1
Sheets("Personel").Cells(a, d + 1) = Hour(Cells(b, 1)) & ":" & Minute(Cells(b, 1))
End If
Next
Next

End Sub

##Minisheet shows the raw data to process

FEBRUARY_2022 Staff Attendance Report.xlsm

A

B

2

17/02/2022 6:43

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

3

17/02/2022 6:43

IB L3 Staff RoomB Locked by (Door Logic) (D042)

4

17/02/2022 6:43

IB L3 Staff RoomB Timed Unlocked for 00 h 00 min 05 s by R25: AdminBuilding L2 Comms Room (Door Logic) (D042)

5

17/02/2022 6:43

Elizabeth Scott Card Access at <R25:Rdr01> into IB L3 Staff RoomB [Card 546599]

6

17/02/2022 6:42

Elizabeth Scott Card Access at <R32:Rdr01> into AdminBuilding SW B [Card 546599]

7

17/02/2022 6:42

IB L1 S Auto Door + PIN Locked by (Door Logic) (D016)

8

17/02/2022 6:42

IB L1 S Auto Door + PIN Timed Unlocked for 00 h 00 min 05 s by R12: AdminBuilding L2 Comms Room (Door Logic) (D016)

9

17/02/2022 6:42

Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]

10

17/02/2022 6:40

E1 Timed Unlocked for 00 h 00 min 05 s by R46: E Block (Door Logic) (D073)

11

17/02/2022 6:40

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

12

17/02/2022 13:43

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

13

17/02/2022 14:44

Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]

14

17/02/2022 14:45

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

15

17/02/2022 16:43

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

16

17/02/2022 16:44

Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]

17

17/02/2022 16:45

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

18

15/02/2022 7:55

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

19

15/02/2022 7:55

IB L3 Staff RoomB Locked by (Door Logic) (D042)

20

15/02/2022 7:55

IB L3 Staff RoomB Timed Unlocked for 00 h 00 min 05 s by R25: AdminBuilding L2 Comms Room (Door Logic) (D042)

21

15/02/2022 7:55

Elizabeth Scott Card Access at <R25:Rdr01> into IB L3 Staff RoomB [Card 546599]

22

15/02/2022 11:40

Elizabeth Scott Card Access at <R32:Rdr01> into AdminBuilding SW B [Card 546599]

23

15/02/2022 11:40

IB L1 S Auto Door + PIN Locked by (Door Logic) (D016)

24

15/02/2022 11:40

IB L1 S Auto Door + PIN Timed Unlocked for 00 h 00 min 05 s by R12: AdminBuilding L2 Comms Room (Door Logic) (D016)

25

15/02/2022 11:40

Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]

26

15/02/2022 11:40

E1 Timed Unlocked for 00 h 00 min 05 s by R46: E Block (Door Logic) (D073)

27

15/02/2022 11:40

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

28

15/02/2022 11:40

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

29

15/02/2022 16:12

Elizabeth Scott Card Access at <R12:Rdr01> into IBr + PIN [Card 546599]

30

15/02/2022 16:11

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

31

15/02/2022 16:11

John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]

32

15/02/2022 16:11

Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]

33

15/02/2022 16:11

Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]

Raw data

##The below shows the end result in the second sheet called "Personel"

FEBRUARY_2022 Staff Attendance Report.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

1

TUE

WED

THU

FRI

SAT

SUN

MON

TUE

WED

THU

FRI

SAT

SUN

MON

TUE

WED

THU

FRI

2

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

3

John Brown

11:40

16:11

6:43

16:43

4

Elizabeth Scott

11:40

16:11

6:42

16:44

5

Abraham Parry

11:40

16:11

6:40

16:45

6

7

Personel

BSALV · Feb 18, 2022

VBA Code:

Sub Pulsar()

     Dim aPersonel

     With Sheets("Personel")
          x = .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row)     'read the personel names
     End With

     ReDim aPersonel(1 To UBound(x), 1 To 62)                   'make dimensions of the array

     With Sheets("Log")
          a = .Range("A1").CurrentRegion.Resize(, 2).Value2     'read the whole log in an array
          mymin = Int(Application.Min(Application.Index(a, 0, 1)))     'smallest date
          mymax = Int(Application.Max(Application.Index(a, 0, 1)))     'largest date
          If Month(mymin) <> Month(mymax) Then MsgBox "problem dates in 2 months": Exit Sub
          If Month(mymin) <> Month(Sheets("Personel").Range("A1").Value) Then MsgBox "wrong month": Exit Sub

          For i = 2 To UBound(a)                                'loop from last row upwards
               For Each strg In Array("admindoor", "lift", "Canteen", "gate")     'list of specific term not to be used
                    b = (InStr(a(i, 2), strg) > 0)              'is that term in that cell = skip that row
                    If b Then Exit For
               Next

               If Not b Then                                    'not a Canteen, gate, ...
                    For p = 1 To UBound(x)                      'loop through all personel names
                         b1 = (StrComp(Left(a(i, 2), Len(x(p, 1))), x(p, 1), vbTextCompare) = 0)     'first part of your log corresponds with somebody
                         If b1 Then p1 = p: Exit For
                    Next

                    If b1 Then                                  'a known personel
                         mydate = Day(a(i, 1))                  'day of the month
                         mytime = a(i, 1) - Int(a(i, 1))        'split timestamp into date and time
                         k = mydate * 2 - 1                     'corresponding column
                         If Len(aPersonel(p1, k)) = 0 Then aPersonel(p1, k) = mytime     'in case arrival is empty, add time
                         aPersonel(p1, k) = Application.Min(mytime, aPersonel(p1, k))     'smallest time
                         aPersonel(p1, k + 1) = Application.Max(mytime, aPersonel(p1, k + 1))     'largest time
                    End If
               End If
          Next
     End With

     Sheets("personel").Range("C3").Resize(UBound(aPersonel), UBound(aPersonel, 2)).Value = aPersonel     'write array to sheet
End Sub

pulsar.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

1

dinsdag 1 februari 2022

2

3

Elizabeth Scott

7:55

16:12

6:42

16:44

4

John Brown

7:55

16:11

6:43

16:43

5

Abraham Parry

11:40

16:11

6:40

16:45

6

personel

Cell Formulas
Range	Formula
C1:AT1	C1	=IF(MOD(COLUMN(),2)=1,C2,"")
C2:AT2	C2	=IF(DAY(EOMONTH($A$1,0))>TRUNC((COLUMN()-3)/2),$A$1+TRUNC((COLUMN()-3)/2),"-")

pulsarkuant · Feb 18, 2022

Thank you, sir, looks amazing but I couldn't figure out how I should embed this solution to the excel I have. I keep receiving range errors. Do you mind if I attach the file I use here for you to have a look?

https://file.io/Lgbbm7W2mIF9
Please note the file is clean and safe.
Kind regards

BSALV · Feb 18, 2022

your file is deleted ?
pulsar
(i don't declare my variables and perhaps, you use "option explicit" ?)

pulsarkuant · Feb 18, 2022

Apology the first time I used the service and mistakenly I hit the done button which is deleting the file.

Upload files for free - FEBRUARY_2022 StaffAttendance Report - Copy.xlsm - ufile.io

Download FEBRUARY_2022 StaffAttendance Report - Copy.xlsm for free from ufile.io instantly, no signup required and no popup ads

ufile.io

BSALV · Feb 18, 2022

february ...
* the macro in #2 isn't in this file, so add it in a normal module or integrate it in your CommandButton1_Click().
* my sheet "log" is your sheet "Raw data" (see bold here below)
* i check a date in A1 of "Personel" (delete that line in bold here below

it think then it works

problems with the bold : bold is between [ B ] and [ / B ]

Excel Formula:

     ReDim aPersonel(1 To UBound(x), 1 To 62)                   'make dimensions of the array

  [B]   With Sheets("Raw Data")[/B]
          a = .Range("A1").CurrentRegion.Resize(, 2).Value2     'read the whole log in an array
          mymin = Int(Application.Min(Application.Index(a, 0, 1)))     'smallest date
          mymax = Int(Application.Max(Application.Index(a, 0, 1)))     'largest date
          If Month(mymin) <> Month(mymax) Then MsgBox "problem dates in 2 months": Exit Sub
   [B]       If Month(mymin) <> Month(Sheets("Personel").Range("A1").Value) Then MsgBox "wrong month": Exit Sub[/B]

          For i = 2 To UBound(a)                                'loop from last row upwards

pulsarkuant · Feb 18, 2022

You are sir, a legend. Thank you so much for your great help.

pulsarkuant · Feb 18, 2022

I just realised, When I load new day's logs, it clears up the previous entries. Since we perform this task daily, it will delete previous entries as well. How can we preserve previously entered In/OUT times?

BSALV · Feb 18, 2022

i think the link is #6 still works and has the latest version
the last part of the macro becomes

VBA Code:

  With Sheets("personel").Range("C3")                        'topleft cell
          For i = 1 To UBound(aPersonel, 2)                     'loop through all the "columns" of the array
               kol = Application.Index(aPersonel, 0, i)         'take "column" i
               If Len(Join(Application.Transpose(kol), "")) > 0 Then     'if that one isn't empty (at least 1 element contains data)
                    .Resize(UBound(aPersonel), 1).Offset(, i - 1).Value = kol     'write that single "column" to  the sheet
               End If
          Next
     End With

pulsarkuant · Feb 18, 2022

Yes indeed sir. All good, thank you so much, you made my day.

Kind regards

FIRST and the LAST time readings from the daily card readings and ignoring the ones in between

pulsarkuant

New Member

Attachments

Excel Facts

BSALV

Banned user

pulsarkuant

New Member

BSALV

Banned user

pulsarkuant

New Member

Upload files for free - FEBRUARY_2022 StaffAttendance Report - Copy.xlsm - ufile.io

BSALV

Banned user

pulsarkuant

New Member

pulsarkuant

New Member

BSALV

Banned user

pulsarkuant

New Member

Similar threads

Forum statistics

Share this page

FIRST and the LAST time readings from the daily card readings and ignoring the ones in between

New Member

Attachments

Excel Facts

Banned user

New Member

Banned user

New Member

Banned user

New Member

New Member

Banned user

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock