Barcode scanning with Excel

[Chief1904]

My office is trying to go paperless with our hunting program and issue ID cards with bar codes. I'm trying to have a barcode scanner be able to scan the ID card and pull up their information in excel or access. How can I do this? My boss doesn't want to spend $12,000 on a full setup of software and hardware. Any help would be great!

 

[rmullings]

L.Howard, Thanks. basically what i am looking to creative a form that will have each child's name in column A, the 5 days of the week as a heading with 2 pots below for time in and time out. Once the code is scanned it will locate the childs name and print the time in or out under the correct day of the week. any help would be appreciated or even links to resources where i can research, thanks

 

[L. Howard]

Okay, say the cell A1 has the header "Urchin Name", cell A2 has child Name 1. (other names below A2 to A?? as needed)

-what cell will have the header "Monday"
-what cell would have the "time in" for the day Monday
-what cell would have the "time out" for the day Monday

What cell will the scan go into AND will the scan be a child name or an ID number that refers to a child's name?

Howard

 

[rmullings]

Ok. A1 will be the scan cell it will be a id number,A2 will be ID # a3 -a15 will be children id, b2 will be header title "Unicorn name" b3 - b15 will have the children's name c1/d1 (merged) will have Monday e1/f1 Tuesday, etc. c2 will have time in header d2 would have time out header for Monday. E2 time in f2 timeout for tues etc.
all punches will then go in c3-c15 for time in on Monday d3-d15 for timeout Monday, e3-e15 for time in Tuesday, f3-f15 for timeout Tuesday etc. for the week.

 

[L. Howard]

Ok. A1 will be the scan cell it will be a id number,A2 will be ID # a3 -a15 will be children id, b2 will be header title "Unicorn name" b3 - b15 will have the children's name c1/d1 (merged) will have Monday e1/f1 Tuesday, etc. c2 will have time in header d2 would have time out header for Monday. E2 time in f2 timeout for tues etc.
all punches will then go in c3-c15 for time in on Monday d3-d15 for timeout Monday, e3-e15 for time in Tuesday, f3-f15 for timeout Tuesday etc. for the week.

I'll set it up that way and see what I can do.

Howard

(Unicorns, not Urchins? Hmm, OK)

 

[L. Howard]

Hi rmullings,

Try this out.

https://www.dropbox.com/s/zhzhqx9n3ror4de/Time Stamp In Out Mon Fri DBox.xlsm?dl=0

Where you will enter (Scan) one of the ID no.'s into cell A1.

It should be noted here that the sheet will respond to a scanned ID number only if when scanned in, it simulates the same action as manually typing the number in the cell and hitting enter. I have no scanner and all my tests are by typing in the test ID no.'s and hitting Enter.

Follow the prompt, click Yes for a scan in, No for a scan out, or Cancel.

There are some error checkers in the code, if you try to enter a scan OUT time and you have no scan IN time, you will get an error message. Follow the prompts on such errors.
If you enter an ID number and click NO for a scan OUT and there is already a scan OUT time in the cell, it will over write the old time with the new time.

The week days, Mon thru Fri, in row 1 are NOT in merged cells. They are in "Centered Across Selection" formatted cells.
( Merged cells should be avoided for the most part, and some experts say avoided all together.)



The codes in the Sheet1 module is these:


Run this should an error occur with the change event code, this will reset enable events to True. Events often are left set to False when an error occurs and the code will sit dormant unless set to True.

Sub EnableEvents_Do()

Run this code, with Ctrl + Shift + D to clear the time field.

Sub Clear_Times_Field()

This is the main Change_Event code, which will respond to changes in cell A1 only. Test thoroughly and see if it does what you wish.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address(0, 0) <> "A1" Or Target.Count > 1 Then Exit Sub


With Target
          
  Application.EnableEvents = False
  On Error GoTo CleanUp
  
  Dim msg, Ans, Cancel
  Dim rngIn As Range
  Dim rngOut As Range
  Dim lRow As Long, Col As Long
  Dim wkDay As String
  
  If Not Intersect(Range("A1"), .Cells) Is Nothing Then
        
     msg = "If this is a scan IN, Click ""YES"" " & vbCr & vbCr & "If this is a scan OUT, Click ""NO""."
     Ans = MsgBox(msg, vbQuestion + vbYesNoCancel)
     
    wkDay = Application.Text(Date, "dddd")
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    Col = Application.Match(wkDay, Range("A1:K1"), 0)
        
       Select Case Ans
         Case vbYes            '*** Scan Time IN *** Yes was clicked
            
            
            Set rngIn = Sheets("Sheet1").Range("A3:A" & lRow) _
                     .Find(What:=Sheets("Sheet1").Range("A1").Value, _
                     LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                     SearchDirection:=xlNext, MatchCase:=False)
            
           If rngIn Is Nothing Then
               MsgBox "No match found."
               Cells(1, 1).ClearContents
               Cells(1, 1).Select
                GoTo CleanUp
           End If
           
           
           If rngIn.Offset(, Col - 1) <> "" Then
              MsgBox "A time has been scanned in for ID no. " _
                     & vbCr & vbCr & "                       " _
                     & rngIn & vbCr & vbCr & _
                     "      Re-scan and choose ""NO""."
             Else
               rngIn.Offset(, Col - 1) = Time
           End If
           
           Sheets("Sheet1").Cells(1, 1).ClearContents
           Sheets("Sheet1").Cells(1, 1).Select
           
                
         Case vbNo   '*** Scan Time OUT *** No was clicked
           
'           wkDay = Weekday(Now())
'           lRow = Cells(Rows.Count, "A").End(xlUp).Row
           
           Set rngOut = Sheets("Sheet1").Range("A3:A" & lRow) _
                         .Find(What:=Sheets("Sheet1").Range("A1").Value, _
                         LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                         SearchDirection:=xlNext, MatchCase:=False)
           
           If rngOut Is Nothing Then
              MsgBox "No match found."
              Cells(1, 1).ClearContents
              Cells(1, 1).Select
              GoTo CleanUp
              
           End If
              
            
           If rngOut.Offset(, Col - 1) <> "" Then
               rngOut.Offset(, Col) = Time
             Else
               MsgBox "There is no scan IN time, you must scan IN first."
           End If

           Sheets("Sheet1").Cells(1, 1).ClearContents
           Sheets("Sheet1").Cells(1, 1).Select

         Case vbCancel     '*** Cancel was clicked
           Cancel = True
           Cells(1, 1).ClearContents
           Cells(1, 1).Select
                
       End Select
               
CleanUp:
        Application.EnableEvents = True
        
  End If
  
End With

End Sub


Sub EnableEvents_Do()
Application.EnableEvents = True
End Sub





Sub Clear_Times_Field()

ActiveSheet.Range(Cells(3, 3), Cells(15, 12)).ClearContents
Cells(1, 1).Select
Application.EnableEvents = True
End Sub

Howard

 

[rmullings]

thanks howard, i will test it tonight when i get home.

 

[Jackw2010]

Hi L.Howard,

Been reading this thread as I am trying to do a similar thing to rmullings, I wonder if you can help me.

Basically I work at a small factory and tools go missing a lot so to try and keep track of who uses what tools we have decided to use a barcode system.

Each tool will have a bar code and each employee has a bar code of their employee number. I want to get a system where each employee scans first their barcode then the tools barcode which will provide a record in excel of who has each tool, then when the tool is returned (Scanned again) it will delete the record.
At the end of each day we can then print a list of all missing tools.

If you could help me it would awesome

Jack

 

[L. Howard]

Hi Jack,

That should be doable. First off, I have no scanner and any codes I have written for scanners is based on the premise that a "scan-in" and a "scan-out" is the sheet event equivalent to typing something in a cell and hitting Enter.

I use 'dummy' barcodes like 123, 124, 125 etc. for the books (tool) and Name1, Name2, Name3 for the students (employee). Instead of scans, I type the dummies in by hand, to simulate a scan.

And do you have in mind how you want the sheet/s set up?

And you most likely have more than one left-hand-monkey wrench so the duplicated tools will each have a barcode and serial number. So employee Lennie has torque wrench Ft/Lbs 10 checked out, and Chad has torque wrench Ft/Lbs 10 checked out, you don't want Lennie to be able to check Chad's torque wrench in and keep the one checked out to himself.

I wrote a book sign out/in where a student scanned an ID number in a cell and scanned the book barcode in another adjacent cell. The date out, the student name, and the book Title are logged in three columns, say J, K, & L.

A scan-in of the student & book barcode erases the J, K, & L data.

Sounds pretty close to what you describe. I'll look to see if I still have it in my archives, if not it can be rewritten.

Howard

 

[Jackw2010]

Howard,

That does sound similar to what I am trying to achieve.

Yes correct we do have multiples of tools but I'm not to bothered about which one they return as long as one is returned. (we are only dealing with small numbers)

The way I was thinking was like you mentioned above; to have columns with employee ID,Tool Barcode, employee name, tool name and time out

Then when the employee returned the tool we would scan his bar code and the tool and that line would be erased. ( this would allow for multiple tools to be taken but could be returned at different times)

I think in terms of setting it up; just a sheet for employee details (ID, Name, Number) Then a sheet for tool details ( ID, Tool name, Qty) Then a sheet that will be used for scanning in and out and displaying all tools out.

I have a list of all employee bar codes with names and am currently creating codes for all tools.

Cheers
Jack

 

[L. Howard]

Hi Jack,

Here is a version of a book checkout, revised to do a generic tool check out.

https://www.dropbox.com/s/vdt4y1lz0z97led/Tool check OUT and IN Drop Box.xlsm?dl=0


A2, B2 & C2 are drop downs which I use to SIMULATE a barcode swipe.

Give a test using the instructions to the right of the sheet.

You mention having three sheets, this has two and everything could easily be on one sheet.

I have Conditional formatting on the first row, Row 4, to be yellow until the tool is returned.

Here are the codes.

Howard


For Sheet1 module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Column > 3 Then Exit Sub
On Error Resume Next

If Target = Range("B2") Then
    ToolCheckOut
  ElseIf Target = Range("C2") Then
    ToolCheckIn
  ElseIf Target = Range("A2") Then
 
    Range("B2").Select
End If

End Sub

For Standard Module 1

Option Explicit

Sub ToolCheckIn()
Dim aList As Range
Dim rngFind As Range
Dim Bcode As Variant
Dim i As Variant

Bcode = Range("C2").Value
If Bcode = "" Then Exit Sub
i = Range("C2").Value

Set aList = Range("D2:D2505")
On Error Resume Next

aList.Select
Set rngFind = Selection.Find(What:=Bcode)

Range("C2").Select

If Not rngFind Is Nothing Then
   Selection.Find(What:=Bcode).Activate
   rngFind.Offset(0, 4).Value = Time
   rngFind.Offset(0, 2).Value = ""
   rngFind.Offset(0, 1).Value = ""
  Else
   MsgBox "This number " & """" & i & """" & " did not match", , "Tool No. Error"
   Range("C2").Value = ""
   Exit Sub
End If

Range("C2").Select
Range("C2").Value = ""
End Sub


Sub ToolCheckOut()

Dim aList As Range
Dim rngFind As Range
Dim Bcode As Variant
Dim i As Variant
Dim sID As Long

sID = Range("A2").Value
Bcode = Range("B2").Value
i = Range("B2").Value

If Bcode = "" Then Exit Sub

Set aList = Range("D2:D2505")

On Error Resume Next

If sID = 0 Then
    MsgBox "        Need Employee ID number " & vbCr & vbCr & _
    "         Scan Employee ID into A2." & vbCr & _
    "Then re-scan Tool bar code into B2.", , "No ID Error"
    Range("B2").Value = ""
    Range("A2").Select
    Exit Sub
End If

aList.Select
Set rngFind = Selection.Find(What:=Bcode)
If Not rngFind Is Nothing Then
    Selection.Find(What:=Bcode).Activate
    rngFind.Offset(0, 4).Value = ""
    rngFind.Offset(0, 2).Value = Now
    rngFind.Offset(0, 1).Value = sID
  Else
    Range("B2").Select
    MsgBox "This number " & """" & i & """" & " did not match", , "Tool No. Error"
    Exit Sub
End If

Range("A2").Select
Range("B2,A2").Value = ""
End Sub