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

 

[igold]

I think I understand what you are trying to accomplish. The only thing I am confused about is your very first sentence below your sample data...

Job numbers are unique

Looking at your data, Job Numbers are NOT unique...

It looks pretty straightforward, I would like to be sure I have not misinterpreted what you want...

 

[SirSquiddly]

Sorry. I meant unique as they increase numerically and wont be repeated. You are correct, there may be 20+ rows of the same job number. The Tool serial number will never be repeated within the same job number but can be allocated to multiple jobs across the year.

So, basically a job comes in. we allocate tools to that job, they go away for a week or two. We can have multiple jobs going at the same time.

Hope that makes sense.

 

[igold]

Using the generic names of "Workbook 1.xlsm" and "Workbook 2.xlsm" and "Sheet1", see if this works for you. Please note that both workbooks must be open before the code is run.

The code should be placed in the "Sheet1" module of "Workbook 2".

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim tool As Range
    Dim lRow As Long
    Dim toolN As String, toolA As String
    
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    toolN = Target.Value
    toolA = Target.Address
    lRow = Workbooks("Workbook 1.xlsm").Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
    Set tool = Workbooks("Workbook 1.xlsm").Worksheets("Sheet1").Range("B2:B" & 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("Workbook 2.xlsm")
        .Worksheets("Sheet1").Range(toolA).Offset(0, -1) = tool.Offset(0, -1).Value
        .Activate
    End With
    
End Sub

I hope this helps.

 

[SirSquiddly]

So I would substitute in my actual names.

workbook 1 = Rental Job Master 2018
Sheet 1 = Rentals

workbook 2 = Job Book
Sheet 1 = Titan Tools

Great. I'll hopefully have some time to play around with this soon. Hopefully I could use this to plug in several bits of data like date of tool hire, customer name and location?

Thanks again.​

 

[igold]

Yes, plug in your actual names in place of my generic names. You will have to massage the code a little if you want to add additional bits of information.

If you run into trouble you can always come back for help.

Thanks for the feedback.

 

[SirSquiddly]

So I have the formula

Dim tool As Range
Dim lRow As Long
Dim toolN As String, toolA As String

If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
toolN = Target.Value
toolA = Target.Address
lRow = Workbooks("Rental Job Master 2018.xlsm").Worksheets("Rentals").Cells(Rows.Count, 2).End(xlUp).Row
Set tool = Workbooks("Rental Job Master 2018.xlsm").Worksheets("Rentals").Range("G8: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, -1).Value
.Activate
End With

End Sub


Nothing really happened. To be fair, this is the first time I've ever used code.

​

workbook 1 = Rental Job Master 2018 ​

​

Sheet 1 = Rentals- serial number is col G​

​

workbook 2 = Job Book​

​

Sheet 1 = Titan Tools - serial number is col B, but I want Col C and D to auto fill with customer name and rig which is Col A and B from Rental Job Master 2018, respectively. Its beyond my skills.​

 

[igold]

Hi,

I have changed the code to what I think you are describing. If this is the first time you're using code, let's be sure that you are putting the code in the right place...

The code below must be copied and pasted to the "Titan Tools 2" sheet module in the "Job Book" workbook. Open that workbook and press the keys ALT + F11 to open the Visual Basic Editor (VBE).

On the left hand side of the VBE you will see VBAProject (Job Book.xlsm). Below that you will see the Sheet Numbers listed with the names of the sheets in brackets. Look for the Sheet named "Titan Tools 2". Double click on that and paste the code into the center part of the VBE. Now close the VBE.

The "Rental Job Master 2018" workbook must also be open as well.

Go to the "Job Book" and on the "Titan Tools 2" sheet you can enter a serial number in column B. That should automatically fill in the "Name" and "Rig" in columns C & D which is being pulled from the information in the "Rental Job Master".

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.xlsm").Worksheets("Rentals").Cells(Rows.Count, 7).End(xlUp).Row
    Set tool = Workbooks("Rental Job Master 2018.xlsm").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

If this does not work for you, please come back and we will have another go at it.

 

[SirSquiddly]

Hi, very much appreciate your patience.

I copied in the code with both workbooks open. A box popped up

Microsoft visual basic

run-time error '9'

Subscript out of range

End Debug Help

Any idea what is going on?

 

[igold]

A subscript error usually means that one of the names of either your workbooks or worksheets do not match what the code is looking for. Double check all your names and make sure what is in the code is what your workbooks/worksheets are. Pay particular attention to any leading or trailing spaces that are not usually noticeable at a glance. Also remember that both workbooks need to be open.