Hi All,
I need some help on the VBA code below. I have tried to draw up my table as best as possible. I am working on a key out/key in inventory. In sheet1 in cells B1 and B8, I have the =today() function to work as a timestamp. I need the code to match cells A2 (Key number) and cells A4 (Type) in sheet2 to find the exact match and input the time stamp on column E and the ID on column C. The function should work similarly when the key is signed in back. I'm not sure if the applicationmatch range can match multiple criteria. Any help on the code will be greatly appreciated.
Sheet1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Key Number Out[/TD]
[TD]12/27/2017[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Type[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Locker[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]ID[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]12345[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Key Number In[/TD]
[TD]12/28/2017[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Type[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Locker[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]ID[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]12345[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Sheet2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]TYPE[/TD]
[TD]KEY NO[/TD]
[TD]ID[/TD]
[TD]NAME[/TD]
[TD]KEY OUT[/TD]
[TD]KEY IN[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]LOCKER[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]PEDESTAL[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
****** id="cke_pastebin" style="position: absolute; top: 218.4px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]12/27/2017[/TD]
[/TR]
</tbody>[/TABLE]
</body>
I need some help on the VBA code below. I have tried to draw up my table as best as possible. I am working on a key out/key in inventory. In sheet1 in cells B1 and B8, I have the =today() function to work as a timestamp. I need the code to match cells A2 (Key number) and cells A4 (Type) in sheet2 to find the exact match and input the time stamp on column E and the ID on column C. The function should work similarly when the key is signed in back. I'm not sure if the applicationmatch range can match multiple criteria. Any help on the code will be greatly appreciated.
Sheet1
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Key Number Out[/TD]
[TD]12/27/2017[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Type[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Locker[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]ID[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]12345[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Key Number In[/TD]
[TD]12/28/2017[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Type[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Locker[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]ID[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]12345[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Sheet2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]TYPE[/TD]
[TD]KEY NO[/TD]
[TD]ID[/TD]
[TD]NAME[/TD]
[TD]KEY OUT[/TD]
[TD]KEY IN[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]LOCKER[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]PEDESTAL[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, ws As Worksheet
Set ws = Sheet2
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Select Case Target.Address(0, 0)
Case "A2", "A4", "A6" 'Key In
If [A2] <> "" And [A4] <> "" And [A6] <> "" Then
v = Application.Match(Range("A2").Value, ws.Range("B:B"), 0)
If IsError(v) Then
MsgBox "Cannot match Key Number: " & Target.Value, vbExclamation, "Invalid Key Number"
Else
ws.Range("E" & v).Value = Date
ws.Range("F" & v).ClearContents
ws.Range("C" & v) = Range("A4").Value
End If
End If
Case "A9", "A11", "A13" 'Key Out
If [A9] <> "" And [A11] <> "" And [A13] <> "" Then
v = Application.Match(Target.Value, ws.Range("B:B"), 0)
If IsError(v) Then
MsgBox "Cannot match Key Number: " & Target.Value, vbExclamation, "Invalid Key Number"
Else
If ws.Range("E" & v).Value = "" Then
MsgBox "No checkout date.", , "Invalid Entry"
Else
ws.Range("F" & v).Value = Date
Range("A11").Value = ws.Range("C" & v).Value
End If
End If
End Select
End Sub
<tbody>[TR]
[TD]12/27/2017[/TD]
[/TR]
</tbody>[/TABLE]
</body>