Inventory VBA

[Pisus]

Hello,
I've received and modified a simple VBA from another excel and i was wondering if anyone could help me modify even more. The thing i need is that the range of this code would be across all documents worksheets.
I1,I2,I3 stays in the first sheet. Date and Name in any other if I2 or I3 match is found.

Private Sub Worksheet_Change(ByVal Target As Range)    Dim c As Range
    Dim lCol As Long
    
    On Error GoTo Terminate
    
    Select Case Target.Address(0, 0)
        Case "I2"
            lCol = 2
        Case "I3"
            lCol = 4
        Case Else
            lCol = 0
    End Select
    
    If Not lCol = 0 Then
        Application.EnableEvents = False
        Set c = Range("F:F").Find(What:=Target.Value)
        If c Is Nothing Then
            MsgBox Target.Value & " not found", vbExclamation + vbOKOnly
            Target.Select
        Else
            Cells(c.Row, lCol).Value = Date
            Cells(c.Row, lCol + 1).Value = Range("I1").Value
        End If
        Target.ClearContents
    End If
    
Terminate:
    Application.EnableEvents = True
End Sub

Thank you for any help or tips.

 

[gallen]

You don't provide enough info. You state:

the range of this code would be across all documents worksheets.

All documents where? in a single folder?

To do this code on all sheets in a workbook is straight forward by moving it to the 'ThisWorkbook' code module in the "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
"

A slight amendment would be needed to confirm the sheet.

 

[Pisus]

What i meant was. A single Excel document with multiple Sheets. First excel sheet would be for entry of a code "I2" or "I3" in this instance. Then it would find the matching value of "I2" or "I3" on any of the sheets, place a date and "I1" (name) in adjacent cells.

 

[gallen]

Fair enough. Can you only ever find it once in the whole workbook or could it be found on multiple sheets?

This is untested but should point you in the right direction. I can see an issue with 'If c is nothing' I've added a comment

Red is the code i've added

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim lCol As Long
[COLOR=#ff0000]    Dim ws As Worksheet[/COLOR]
    
    On Error GoTo Terminate
    
    Select Case Target.Address(0, 0)
        Case "I2"
            lCol = 2
        Case "I3"
            lCol = 4
        Case Else
            lCol = 0
    End Select
    
    If Not lCol = 0 Then
        Application.EnableEvents = False
        'loop through all sheets
[COLOR=#ff0000]        For Each ws In Worksheets[/COLOR]
            Set c = [COLOR=#ff0000]ws[/COLOR].Range("F:F").Find(What:=Target.Value)
            If c Is Nothing Then
                'Target Not found so do nothing for now?
                'MsgBox Target.Value & " not found", vbExclamation + vbOKOnly
                'Target.Select
            Else
                [COLOR=#ff0000]ws[/COLOR].Cells(c.Row, lCol).Value = Date
                [COLOR=#ff0000]ws[/COLOR].Cells(c.Row, lCol + 1).Value = Range("I1").Value
            End If
[COLOR=#ff0000]        Next ws[/COLOR]
        Target.ClearContents
    End If
    
Terminate:
    Application.EnableEvents = True
End Sub