Scan barcode to excel with date & time stamp in & out.

[qpywsqp]

Hi all. I have research around the internet and finally found out Macro able to solve my issue. But im totally not a programmer. Hopefully someone can help me on this.

I will scan QR Code with a scanner to cell A1 and wanted cell C1 to have date and time stamp for IN. When Scanner scan the same QR Code, D1 will have date and time stamp for out. If repeat third time scanning the same QR code after a few scanning, it will appear on next row. Which means A8 with the code and C8 with date and time stamp for IN again.

Is that possible to done with Macro?

 

[Kadam18]

Kadam18,

The only way to do what you are requesting is to have the worksheet setup something like the following:

Excel 2007

	A	B	C	D	E	F	G	H
1	Name
2
3
4	Name	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)
5	James	11.08.2016 14:39:50	11.08.2016 14:43:59	00:04:09	11.08.2016 14:46:01	11.08.2016 14:47:09	00:01:09
6	Andy	11.08.2016 15:03:04	11.08.2016 15:05:15	00:01:49
7

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

You will only be able to type in/scan a name in cell A2 (yellow cell).

The Worksheet_Change event will find the next blank cell in column A, below the new titles, beginning in cell A5, add the new name and time.

Then cell A2 will be cleared.

Is this acceptable to you?

Hi there,

That would work brilliantly, as it might not always be me controlling the sheet. This would make it much easier to teach other people to use it.

Thanks you.

 

[hiker95]

Hi there,

That would work brilliantly, as it might not always be me controlling the sheet. This would make it much easier to teach other people to use it.

Thanks you.

Kadam18,

What is the maximum number of times the same Name could be entered in cell A2?

The reason I am asking, is that to cover the above answer, the first three titles in in range B4:D4 would have to be copied to the right that number of times, and, then some.

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Name
2
3
4	Name	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)
Sheet1

 

[Kadam18]

Kadam18,

What is the maximum number of times the same Name could be entered in cell A2?

The reason I am asking, is that to cover the above answer, the first three titles in in range B4:D4 would have to be copied to the right that number of times, and, then some.

Excel 2007

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Name
2
3
4	Name	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Hi There,

In theory it could be unlimited, however this is for a running group to monitor times and watch improvement over several months, so I guess that one evening a week, would be a maximum of 5 weeks a month, name being scanned twice (once in and once out), the maximum number of times the same barcode (or name) will be scanned into A2 on each sheet will be 10? if my maths is correct!

Thanks

 

[hiker95]

the maximum number of times the same barcode (or name) will be scanned into A2 on each sheet will be 10

Kadam18,

With the above quote in mind, make sure that in row 4, that the headings in range B4:D4, are copied all the way out to range AC4:AE4, like the below screenshot (not all columns are shown for brevity).

Excel 2007
	A	B	C	D	AC	AD	AE	AF
1	Name
2
3
4	Name	Time Out	Time In	Time (hh:mm:ss)	Time Out	Time In	Time (hh:mm:ss)
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel

Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 11/09/2016, ME672492
Dim na As Range, rng As Range, nr As Long, nc As Long
If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Set rng = .Range("A4", .Cells(.Rows.Count, "A").End(xlUp))
  Set na = rng.Find(Target.Value, LookAt:=xlWhole)
  If na Is Nothing Then
    nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    Me.Cells(nr, 1).Value = Target.Value
    With Me.Cells(nr, 2)
      .Value = Now()
      .NumberFormat = "mm.dd.yyyy hh:mm:ss"
    End With
  ElseIf Not na Is Nothing Then
    nc = Me.Cells(na.Row, .Columns.Count).End(xlToLeft).Column + 1
    With Me.Cells(na.Row, nc)
      .Value = Now()
      .NumberFormat = "mm.dd.yyyy hh:mm:ss"
    End With
    If Me.Cells(4, nc + 1).Value = "Time (hh:mm:ss)" Then
      With Me.Cells(na.Row, nc + 1)
        .FormulaR1C1 = "=RC[-1]-RC[-2]"
        .NumberFormat = "hh:mm:ss"
        .Value = .Value
      End With
    End If
    If Me.Cells(4, nc + 1).Value = "Time (hh:mm:ss)" Then
      With Me.Cells(na.Row, nc + 1)
        .FormulaR1C1 = "=RC[-1]-RC[-2]"
        .NumberFormat = "hh:mm:ss"
        .Value = .Value
      End With
    End If
  End If
  With Me.Cells(2, 1)
    .ClearContents
    .Select
  End With
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

Before you use the above code with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[Kadam18]

Hi there,

Apologies for the slow reply. was off work for a couple of days.

Thank you ever so much for that, it is awesome!

 

[hiker95]

Kadam18,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[theburrow]

hiker95,

I need a little assistance... I adapted your macro and sheet to create a access log which references VLOOPUP to populate cells when a bar code is scanned. That portion works fine. I would like to add a cell at the end of each row that displays the status "In" or "Out". I will be utilizing this workbook on a construction site and would like to know who is on the site in the event of an emergency.

Scan Code:

Name:

Company

In:

Out:

In:

Out:

In:

Out

In:

Out

In:

Out

In:

Out

Status:

100724

Dan Kane

Company B

16:00

16:24

16:55

18:00

OUT

100722

Robert Jose

Company A

16:00

16:35

16:58

17:30

19:25

IN

<tbody>
</tbody>

 

[hiker95]

hiker95,

I need a little assistance... I adapted your macro and sheet to create a access log which references VLOOPUP to populate cells when a bar code is scanned. That portion works fine. I would like to add a cell at the end of each row that displays the status "In" or "Out". I will be utilizing this workbook on a construction site and would like to know who is on the site in the event of an emergency.

theburrow,

Welcome to the MrExcel forum.


To start off, can I see the macro code that you have modified?


When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]

 

[theburrow]

Hiker95,

Thank you for your quick reply!
As I stated before, I work on a construction site and I would like to implement an access control/accountability procedure. As with anything, funding is non-existent. I have a basic working knowledge of excel. Luckily enough there are resources such as Mr. Excel and Youtube.

The main purpose of the log would be to keep track of when and where everyone is. Below is a sample of the sheet. A new sheet would be created each work day to prevent over-run from the previous day.

Scan Code

Name

Company

Date

In

Out

In

Out

In

Out

In

Out

In

Out

In

Out

Status

<tbody>
</tbody>

Like I said I used the code you provided earlier in this thread. Now I have been using a VLOOPUP formula to populate the name and company fields. That has not been a problem.

=IF(A2="","",VLOOKUP(A2,'Master Access List'!A:E,2,FALSE))

I wanted to know if as “status” cell could be added at the end of the row. This would be useful in the event of an emergency; we could tell who was on the jobsite. It would indicate if some (based on time they scanned with a barcode) that they were “IN” or “Out”.

Additionally, I have been running into a “Circular Reference” issue with the date. Even though I said a new log would be created each day I would still like that feature.

=IF(A2<>"",IF(D2="",NOW(),D2),"")

Any help or advice would be greatly appreciated. Also if there is a way to do the VLOOKUP in VBA that would greatly improve the chances of a user not messing the log up.

Thanks!
Below is the code I used originally:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 02/04/2013
' http://www.mrexcel.com/forum/excel-questions/672492-scan-barcode-excel-date-time-stamp-out.html
If Intersect(Target, Range("A2:A3000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim lc As Long, fr As Long, n As Long, nr As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  n = Application.CountIf(Columns(1), Cells(Target.Row, 1))
  If n = 1 Then
    lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
    If lc <= 5 Then
      Cells(Target.Row, 5) = Format(Now, "m/d/yyyy h:mm")
    ElseIf lc > 4 Then
      Cells(Target.Row, lc + 1) = Format(Now, "m/d/yyyy h:mm")
    End If
  Else
    fr = 0
    On Error Resume Next
    fr = Application.Match(Cells(Target.Row, 1), Columns(1), 0)
    On Error GoTo 0
    If fr > 0 Then
      lc = Cells(fr, Columns.Count).End(xlToLeft).Column
      If lc < 5 Then
        Cells(fr, 5) = Format(Now, "m/d/yyyy h:mm")
      ElseIf lc > 4 Then
        Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
      End If
      Target.ClearContents
    End If
  End If
  On Error Resume Next
  Me.Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  nr = Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
  Me.Cells(nr, 1).Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

 

[hiker95]

theburrow,

I do not understand what you are trying to do.

In order to continue, I would like to see your actual raw data workbook/worksheets.

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com