to match targets to range and timestamp date

shawn1983

New Member
Joined
Dec 27, 2017
Messages
3
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]


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
****** 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>
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top