Auto Cell input

[SirSquiddly]

Hi,

Any help with the following problem would be greatly appreciated.

So I have 2 seperate workbooks (not sheets) 1 & 2).

Workbook 1

Job#	Serial code
job1	T123
job1	AW5566
job2	T100
job3	T101
job3	T307
job3	T308
job4	T123
job4	AW5566
job4	T200

<tbody>
</tbody>

Job numbers are unique + increase numerically, currently on approx 00950 and increasing. Serial numbers of tools on each job vary, and can have multiple tools and will be on more than one job (but not at the same time).E.g., Tool T123 could be on job 1 then 3 weeks later T123 could be on job4. We have over 1000+ tools/serial codes.

I have a separate workbook (2) that I would like to auto fill. For example, if I input serial code into B1 of workbook 2, A1 of workbook 2 would auto fill with the last job number from workbook 1. A drop box of all the jobs that serial number had been on would be ok but Ideally the last job which is towards the bottom of workbook 1.

Any help much appreciated.

thanks

 

[SirSquiddly]

Double checked names, spaces and both sheets are open. I clicked debug and this line of code is highlighted yellow.

lRow = Workbooks("Rental Job Master 2018.xlsm").Worksheets("Rentals").Cells(Rows.Count, 7).End(xlUp).Row

 

[igold]

Is the "Rental Job Master 2018" saved as a xlsm file or is it an xls or xlsx file...

 

[SirSquiddly]

xlsx

 

[igold]

You have to change these two lines as indicated in red...

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim tool As Range
    Dim lRow As Long
    Dim toolN As String, toolA As String
    
    Application.ScreenUpdating = False
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    toolN = Target.Value
    toolA = Target.Address
    lRow = Workbooks("Rental Job Master 2018.[COLOR=#ff0000]xlsx[/COLOR]").Worksheets("Rentals").Cells(Rows.Count, 7).End(xlUp).Row
    Set tool = Workbooks("Rental Job Master 2018.[COLOR=#ff0000]xlsx[/COLOR]").Worksheets("Rentals").Range("G2:G" & lRow).Find(What:=toolN, _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not tool Is Nothing Then
            Application.Goto tool, True
        Else
            MsgBox "Nothing found"
            Exit Sub
        End If
    With Workbooks("Job Book.xlsm").Worksheets("Titan Tools 2")
        .Range(toolA).Offset(0, 1) = tool.Offset(0, -6).Value
        .Range(toolA).Offset(0, 2) = tool.Offset(0, -5).Value
        .Activate
    End With
    Application.ScreenUpdating = True
    
End Sub

 

[SirSquiddly]

Hi. Apologies in delay, but no luck with the formula. I noticed the Job Book is saved as excel 97-2003 (*.xls) so I tried changing the cod for Job Book to xls but no joy. Any other ideas? thanks