• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Time stamping multiple columns while deleting previously entered cell

T

trickshot829

New Member
Background:


Our technicians produce finished goods.

The time to build the finished goods, along with all of its sub-components, is not being tracked.

I am going to track this via barcode scanning check-in/check-out.

I am going to benchmark the time to put together a finished good (time study) and then analyze data from there.


Each task has a barcode associated.

When technician starts Task 1, they scan associated barcode, "Task 1".

Technicians get interrupted during production so they must check-out.

When technician resumes build they must check back in.


The code below does this:


When "Task 1" is scanned into excel, column A is populated with "Task 1" while column B is populated with the time of scan.

The next time the "Task 1" barcode is scanned, column C is populated with the time of Scan.

This gives the time during the build.

Every time thereafter "Task 1" is scanned, column C is updated with the most recent time.

This creates inaccurate information.


What I need:


Leave the code as is. Except, after the second time "Task X" is entered, start filling in the next columns.


E.g.


A B C D E

Task 1 1am 1:30am 3:30pm 4:00pm


This will show the start and stop time each time the barcode is scanned, rather than just two times. Does that make sense?


Also, if possible, I would like the last cell to have its contents cleared rather than delete the entire row. Here is what I have so far:


Private Sub Worksheet_Change(ByVal Target As Range)

' Code goes in the Worksheet specific module

Dim Rng As Range

Dim strTracking As String

' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")

Set Rng = Target.Parent.Range("A:A")

' Only look at single cell changes

If Target.Count > 1 Then Exit Sub

' Only look at that range

If Intersect(Target, Rng) Is Nothing Then Exit Sub

' Action if Condition(s) are met

Application.EnableEvents = False

' Look for the Tracking #

strTracking = Columns("A").Find(Target.Value).Address

' If the Tracking # exists, then time stamp the original and delete the Out scan

If strTracking <> Target.Address Then

Range(strTracking).Offset(, 2).Value = Format(Now, "hh:mm:ss AM/PM")

Target.EntireRow.Delete

ActiveCell.Offset(-1, 0).Select

Else

' If the Tracking # doesn't exist then enter it and the In time stamp

Target.Offset(0, 1).Value = Format(Now, "hh:mm:ss AM/PM")

End If

Application.EnableEvents = True


End Sub
 
Hi ,


Can you try this out ?

[pre]
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
' Code goes in the Worksheet specific module
Dim Rng As Range
Dim strTracking As String

Dim LastCell As Range
Dim LastCellColumnNumber As Long
Dim RowNumber As Long

' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set Rng = Target.Parent.Range("A:A")

' Only look at single cell changes
If Target.Count > 1 Then Exit Sub

' Only look at that range
If Intersect(Target, Rng) Is Nothing Then Exit Sub

' Action if Condition(s) are met
Application.EnableEvents = False

' Look for the Tracking #
strTracking = Columns("A").Find(Target, Target).Address

' If the Tracking # exists, then time stamp the original and delete the Out scan
If strTracking <> Target.Address Then
' Code copied from Chip Pearson's site : http://www.cpearson.com/excel/LastCell.aspx
''''''''''''''''''''''''''''''''''''''
' Last cell in row
''''''''''''''''''''''''''''''''''''''
With Range(strTracking)
RowNumber = .Row
If ActiveSheet.Cells(RowNumber, ActiveSheet.Columns.Count) <> vbNullString Then
Set LastCell = .Cells(RowNumber, ActiveSheet.Columns.Count)
LastCellColumnNumber = LastCell.Column
Else
Set LastCell = ActiveSheet.Cells(RowNumber, ActiveSheet.Columns.Count).End(xlToLeft)
LastCellColumnNumber = LastCell.Column
End If

.Offset(, LastCellColumnNumber).Value = Format(Now, "hh:mm:ss AM/PM")
Target.EntireRow.Delete
.Offset(0).Select
Columns(LastCellColumnNumber + 1).AutoFit
End With
Else
' If the Tracking # doesn't exist then enter it and the In time stamp
Target.Offset(0, 1).Value = Format(Now, "hh:mm:ss AM/PM")
End If
Application.EnableEvents = True
End Sub
[/pre]
Narayan
 
Thank you for the help!


The issues I encountered:


I need the entries in column A to stay, but for only the first entry.


E.g.


These entries:

Step 1 9am

Step 1 9:30am

Step 1 9:35 am


Should show this as a final result:


Step 1 9am 9:30am 9:35am


Until I enter a new value such as Step 2 which it then creates a new row.


My final output should look like:


Step 1 9am 9:30am 9:35am

Step 2 10am 10:30am 10:35am

Step 3 11am 11:30am 11:35am

Step 4 12am 12:30am 12:35am


So as you see the next cell to enter a value should be the next empty cell underneath, as to not overwrite the most recently added entry.


Something that kind of gets what I want to do:


Enter "Task 1" 9am 9:30am

Enter "Task 1" --------------^ (delete this current cell, but stay located in the cell)


An exmaple would be to make an entry twice, and then run this macro:


Sub GoToLast()

ActiveSheet.Cells(Rows.Count, 1).End(xlUp) _

.Offset(1, 0).Select

End Sub


But that takes the smoothness out of it. Hope that makes sense?


And yes, it appears this code was copied from that site, thank you. I did not know that!
 
Hi ,


I am not able to understand exactly what your problem is , but form what I can guess , you want the cursor to remain in the first blank cell in column A. If this is so , replace the following two lines in the earlier posted code :

[pre]
Code: 
Target.EntireRow.Delete
.Offset(0).Select
with these two lines :

Target.EntireRow.ClearContents
Target.Cells(1, 1).Select
[/pre]
Narayan
 
Narayan, that is exactly what I needed! Thank you so much- HUGE help.


If anyone needs it, here is the final version:


Private Sub Worksheet_Change(ByVal Target As Range)

' Code goes in the Worksheet specific module

Dim Rng As Range

Dim strTracking As String


Dim LastCell As Range

Dim LastCellColumnNumber As Long

Dim RowNumber As Long


' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")

Set Rng = Target.Parent.Range("A:A")


' Only look at single cell changes

If Target.Count > 1 Then Exit Sub


' Only look at that range

If Intersect(Target, Rng) Is Nothing Then Exit Sub


' Action if Condition(s) are met

Application.EnableEvents = False


' Look for the Tracking #

strTracking = Columns("A").Find(Target, Target).Address


' If the Tracking # exists, then time stamp the original and delete the Out scan

If strTracking <> Target.Address Then

' Code copied from Chip Pearson's site : http://www.cpearson.com/excel/LastCell.aspx

''''''''''''''''''''''''''''''''''''''

' Last cell in row

''''''''''''''''''''''''''''''''''''''

With Range(strTracking)

RowNumber = .Row

If ActiveSheet.Cells(RowNumber, ActiveSheet.Columns.Count) <> vbNullString Then

Set LastCell = .Cells(RowNumber, ActiveSheet.Columns.Count)

LastCellColumnNumber = LastCell.Column

Else

Set LastCell = ActiveSheet.Cells(RowNumber, ActiveSheet.Columns.Count).End(xlToLeft)

LastCellColumnNumber = LastCell.Column

End If


.Offset(, LastCellColumnNumber).Value = Format(Now, "hh:mm:ss AM/PM")

Target.EntireRow.ClearContents

Target.Cells(1, 1).Select

Columns(LastCellColumnNumber + 1).AutoFit

End With

Else

' If the Tracking # doesn't exist then enter it and the In time stamp

Target.Offset(0, 1).Value = Format(Now, "hh:mm:ss AM/PM")

End If

Application.EnableEvents = True

End Sub
 
You must log in or register to reply here.
Back
Top