Home > Net >  VBA FIND function Lookup array
VBA FIND function Lookup array

Time:09-03

The Code gives a "application-defined or object-defined error" on the following line

Set Job_Array = Workbooks("Master Permitting-Test Sheet Copy Code").Worksheets("Sheet1").Range("A5", Range("A5").End(xlDown))

The rest of the code is as followed. The Code is suppose to open an Old_Workbook start a loop at cell A5 the code takes the value of A5 in the Old_Workbook & checks the New_workbook for an exact match. If a match of the new workbook is found then the code offsets from the Old_Worksheet 3 column and copies that cell where it then should offset 3 column in the New_Workbook and paste that cell value. Then the code steps down the the next A6 and repeats the loop for the next Old_Job_Name.

Sub Copy_Code()

Dim FileLocation As String
Dim Old_Workbook As Workbook
Dim New_Workbook As Workbook
Dim New_Job_Range As Range
Dim Old_Job_Name As String
Dim Job_Array As Range



Dim n As Integer
Dim Last_Old_Job As Integer


'gets input from user for file string name
FileLocation = Application.GetOpenFilename

'opens last weeks file and sets WB object for new workbook
Set Old_Workbook = Application.Workbooks.Open(FileLocation)
Set New_Workbook = Workbooks("Master Permitting-Test Sheet Copy Code")


'Find the last old job name in the old workbook
Last_Old_Job = Old_Workbook.Worksheets("Sheet1").Range("A5", Range("A5").End(xlDown)).Count



    'Establish loop from the first old job to the last old job
    For n = 1 To Last_Old_Job

        'defines old job name, Starts in cell A5 and steps rows by 1 each time the loop is completed
        Old_Job_Name = Old_Workbook.Worksheets("Sheet1").Range("A5").Offset(n - 1, 0).Value

        'Defines look up array in new workbook
        Set Job_Array = Workbooks("Master Permitting-Test Sheet Copy Code").Worksheets("Sheet1").Range("A5", Range("A5").End(xlDown))

        'Sets the New_Job_Range equal to the cell where the old job matchs the new job
        Set New_Job_Range = Job_Array.Find(Old_Job_Name, LookIn:=xlValues, lookat:=xlWhole)

            'If New_Job_Range is not nothing (as in a match has been found) then offset the column by 3 on the old workbook and paste that data
            'offset 3 columns from the New_Job_Range
            If Not New_Job_Range Is Nothing Then
                Old_Job_Name = Old_Workbook.Worksheets("Sheet1").Range("A5").Offset(n - 1, 3).Copy
                New_Job_Range.Offset(0, 3).Paste


             End If


Next n

End Sub

CodePudding user response:

You have to insert this before setting the Job_Array range, because Excel, at that very moment, has the Old_Workbook as the ActiveWorkbook, and that formula refers to Range("A5").End(xlDown) without the full qualifying 'path' to that range.

New_Workbook.Activate
  • Related