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

pulsarkuant

New Member
Joined
Jan 9, 2011
Messages
20
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
AB
217/02/2022 6:43John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
317/02/2022 6:43IB L3 Staff RoomB Locked by (Door Logic) (D042)
417/02/2022 6:43IB L3 Staff RoomB Timed Unlocked for 00 h 00 min 05 s by R25: AdminBuilding L2 Comms Room (Door Logic) (D042)
517/02/2022 6:43Elizabeth Scott Card Access at <R25:Rdr01> into IB L3 Staff RoomB [Card 546599]
617/02/2022 6:42Elizabeth Scott Card Access at <R32:Rdr01> into AdminBuilding SW B [Card 546599]
717/02/2022 6:42IB L1 S Auto Door + PIN Locked by (Door Logic) (D016)
817/02/2022 6:42IB L1 S Auto Door + PIN Timed Unlocked for 00 h 00 min 05 s by R12: AdminBuilding L2 Comms Room (Door Logic) (D016)
917/02/2022 6:42Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]
1017/02/2022 6:40E1 Timed Unlocked for 00 h 00 min 05 s by R46: E Block (Door Logic) (D073)
1117/02/2022 6:40Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]
1217/02/2022 13:43John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
1317/02/2022 14:44Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]
1417/02/2022 14:45Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]
1517/02/2022 16:43John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
1617/02/2022 16:44Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]
1717/02/2022 16:45Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]
1815/02/2022 7:55John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
1915/02/2022 7:55IB L3 Staff RoomB Locked by (Door Logic) (D042)
2015/02/2022 7:55IB L3 Staff RoomB Timed Unlocked for 00 h 00 min 05 s by R25: AdminBuilding L2 Comms Room (Door Logic) (D042)
2115/02/2022 7:55Elizabeth Scott Card Access at <R25:Rdr01> into IB L3 Staff RoomB [Card 546599]
2215/02/2022 11:40Elizabeth Scott Card Access at <R32:Rdr01> into AdminBuilding SW B [Card 546599]
2315/02/2022 11:40IB L1 S Auto Door + PIN Locked by (Door Logic) (D016)
2415/02/2022 11:40IB L1 S Auto Door + PIN Timed Unlocked for 00 h 00 min 05 s by R12: AdminBuilding L2 Comms Room (Door Logic) (D016)
2515/02/2022 11:40Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]
2615/02/2022 11:40E1 Timed Unlocked for 00 h 00 min 05 s by R46: E Block (Door Logic) (D073)
2715/02/2022 11:40Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]
2815/02/2022 11:40John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
2915/02/2022 16:12Elizabeth Scott Card Access at <R12:Rdr01> into IBr + PIN [Card 546599]
3015/02/2022 16:11Abraham Parry Card Access at <R46:Rdr03> into E1Door [Card 658215]
3115/02/2022 16:11John Brown Card Access at <R41:Rdr03> into B7Door [Card 546888]
3215/02/2022 16:11Elizabeth Scott Card Access at <R12:Rdr01> into IB L1 S Auto Door + PIN [Card 546599]
3315/02/2022 16:11Abraham 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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKAL
1TUEWEDTHUFRISATSUNMONTUEWEDTHUFRISATSUNMONTUEWEDTHUFRI
2112233445566778899101011111212131314141515161617171818
3John Brown11:4016:116:4316:43
4Elizabeth Scott11:4016:116:4216:44
5Abraham Parry11:4016:116:4016:45
6
7
Personel
 

Attachments

  • Explaination.jpg
    Explaination.jpg
    169.8 KB · Views: 4

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASAT
1dinsdag 1 februari 2022di wo do vr za zo ma di wo do vr za zo ma di wo do vr za zo ma di 
20101020203030404050506060707080809091010111112121313141415151616171718181919202021212222
3Elizabeth Scott7:5516:126:4216:44
4John Brown7:5516:116:4316:43
5Abraham Parry11:4016:116:4016:45
6
personel
Cell Formulas
RangeFormula
C1:AT1C1=IF(MOD(COLUMN(),2)=1,C2,"")
C2:AT2C2=IF(DAY(EOMONTH($A$1,0))>TRUNC((COLUMN()-3)/2),$A$1+TRUNC((COLUMN()-3)/2),"-")
 
Upvote 0
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
 
Upvote 0
your file is deleted ?
pulsar
(i don't declare my variables and perhaps, you use "option explicit" ?)
 
Upvote 0
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
 
Upvote 0
Solution
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?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,268
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top