Kadam18,
Welcome to the MrExcel forum.
I would like more information. Please see the Forum Use Guidelines in the following
link:
http://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html
See
reply #2 at the next
link, if you want to show small
screenshots, of the raw data, and, what the results should look like.
http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729
Or, 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
Hi there, thanks for the reply.
I would like to be able to scan people out and back in again and I would like the spreadsheet to show how long the person was out for, as well as the time out and the time in again. as per the spreadsheet below. I am currently using the following code that you provided much earlier...
Private Sub Worksheet_Change(ByVal Target As Range)' hiker95, 12/18/2012
'
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 = 1 Then
Cells(Target.Row, lc + 2) = Format(Now, "dd.mm.yyyy h:mm:ss")
ElseIf lc > 2 Then
Cells(Target.Row, lc + 1) = Format(Now, "dd.mm.yyyy h:mm:ss")
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 = 1 Then
Cells(fr, lc + 2) = Format(Now, "dd.mm.yyyy h:mm:ss")
ElseIf lc > 2 Then
Cells(fr, lc + 1) = Format(Now, "dd.mm.yyyy h:mm:ss")
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
Spreadsheet example
| Name | | Time Out | Time In | Time (hh:mm:ss) | Time Out | Time In | Time (hh:mm:ss) |
| James | | 08.11.2016 15:10:03 | 08.11.2016 15:10:04 | | 08.11.2016 15:10:05 | | |
| Andy | | 08.11.2016 15:10:24 | 08.11.2016 15:10:51 | | | | |
| Adam | | 08.11.2016 15:10:35 | | | | | |
| Mark | | 08.11.2016 15:10:40 | 08.11.2016 15:10:42 | | | | |
| Dave | | 08.11.2016 15:10:47 | | | | | |
| | | | | | | |
<colgroup><col span="2"><col span="6"></colgroup><tbody>
</tbody>
