Hi, I cannot seem to make my check in/out form work as needed. The issue or issues are when I scan into sheet 3 I find a value in a range. If found column c and d are copied to sheet 4 next available row. This part works. Issue 1: I need to look at sheet 4 column A and if copied value column C now residing in column A of sheet 4 exists then check column F on sheet 4 of same row for a date. If no date then fill row/column with (Now) and Number format. Issue 2: Same function, find value in column A and if a date does exist in column F then a new row is started with checked out date in column (E). I am using If Else to try and make this work and also tried Case but my limited skills are keeping me from completing this. Part of issue 1: If column F is filled in with a date then column D needs to be overwritten with the name of person checking in. The name if also found scanning into sheet 2 using a table and copying name over to sheet 4 column D. Not sure if holding a value until something else happens is possible in excel. Sheet 3 code is shown below. Sorry, I know indents are all over. As I indicated, Limited!! vba is very new to me.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FindString As String
Dim FindStringID As String
Dim Rng As Range
Dim bcr As Range
Dim nr As Long
Dim nc As Long
Dim irow As Long
Dim Standard As String
Dim Description As String
Dim rng1 As Range
Dim Response As Integer
Set ws = Worksheets("Report")
If Target <> Range("A1") Then
MsgBox ("You can only scan Barcodes into Sheet3 range A1")
ActiveCell.ClearContents
Range("A1").Select
End If
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
'Find cell A1 value in column B and populate sheet 4 report
FindString = Sheets("StandardTable").Range("A1")
If Trim(FindString) <> "" Then
With Sheets("StandardTable").Range("B2:B500")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End If
'Collect Standard Information.
If Rng Is Nothing Then Response = MsgBox("Do You Want To Add Standard?", vbYesNo, "Add Standard")
If Response = vbYes Then
Standard = InputBox("Enter Standard ID.", "MPD Number")
With Sheets("StandardTable")
NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
.Range("C" & NextRow) = Standard
End With
Description = InputBox("Enter Standard Description.", "Description")
With Sheets("StandardTable")
NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
.Range("D" & NextRow) = Description
End With
ID = InputBox("Scan RFID Tag Now.", "Standards RFID Tag")
With Sheets("StandardTable")
NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
.Range("B" & NextRow) = ID
End With
MsgBox "Scan Standard RFID Again", vbOKOnly
UserForm1.Show
End If
If Response = vbNo Then
MsgBox "Standard Not Found"
End If
End With
'If standard is checked in and row complete then following code applies
With ws
irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).row
On Error Resume Next
ws.Cells(irow, 1).Value = Application.Index(Range("C2:C500"), Application.Match(Range("A1").Value, Range("B2:B500"), 0))
ws.Cells(irow, 2).Value = Application.Index(Range("D2:D500"), Application.Match(Range("A1").Value, Range("B2:B500"), 0))
On Error GoTo 0
FindStringID = ws.Cells(irow, 1).Value
If Trim(FindStringID) <> "" Then
With Sheets("Report").Range("A2:A500")
Set rng1 = .Find(What:=FindStringID, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End If
If rng1 = 0 & ws.Range("F" & irow) = 1 Then
irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).row + 0
ws.Range("A" & irow) = ws.Cells(irow, 1).Value
ws.Range("B" & irow) = ws.Cells(irow, 2).Value
ws.Range("E" & irow) = now()
ws.Range("E" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
'If standard is checked out but not in then following code applies.
Else
If rng1 = 1 & ws.Range("F" & irow) = 0 Then
ws.Range("F" & irow) = now()
ws.Range("F" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
'Replace with code to populate checked in cloumn (F) on active row and overwrite associate name column (D)
End If
End If
End With
With Sheets("StandardTable").Range("A1")
.ClearContents
UserForm1.Show
End With
With Application
'Sheets("Report").Save
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
