Inventory VBA

Pisus

New Member
Joined
Nov 14, 2019
Messages
5
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.
Code:
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

Well-known Member
Joined
Jun 27, 2011
Messages
1,913
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

New Member
Joined
Nov 14, 2019
Messages
5
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

Well-known Member
Joined
Jun 27, 2011
Messages
1,913
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

Code:
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
 

Forum statistics

Threads
1,078,309
Messages
5,339,410
Members
399,302
Latest member
Swiftymj

Some videos you may like

This Week's Hot Topics

Top