runtime error 424, object required

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,397
Office Version
  1. 2007
I've written this code and it works ok but while trying to tidy it and change some working names to final names I now get the error ' runtime error 424, object required'


Rich (BB code):
Sub findlen2()
'
' findlen2 Macro
'
Dim tbl As ListObject
Dim leng As Integer
Dim lengdest As Integer
Dim Rownumber As Integer
Dim chan As String
Dim eventtype As String
Dim eventname As String
Dim date1 As Date
Dim starttime As Date
Dim endtime As Date
Dim sourcebook As String
Dim destinationbook As String
Dim destrow As Integer
Dim thissheetname As String
destinationbook = Sheets("admin").Range("k6")
MsgBox destinationbook
thissheetname = ActiveSheet.Name
MsgBox thissheetname
'find length of table
    Set tbl = ThisWorkbook.ActiveSheet.ListObjects(1)
    leng = tbl.DataBodyRange.Rows.Count
    MsgBox leng
'find first paste row in target book
    Set tbl = Workbooks("twelve.xlsm").Worksheets(thissheetname).ListObjects(1)
    lengdest = tbl.DataBodyRange.Rows.Count + 3
    MsgBox lengdest


For n = 1 To leng
    If ThisWorkbook.ActiveSheet.Range("T" & n + 3) <> "Y" Then GoTo notransfer
    
    
    'transfer columns
    
    ThisWorkbook.ActiveSheet.Range("T" & n + 3) = "R"
    
    'copy coloums
    Rownumber = n + 3
    MsgBox n
    chan = Cells(Rownumber, "c")
    date1 = Cells(Rownumber, "b")
    eventtype = Cells(Rownumber, "d")
    eventname = Cells(Rownumber, "e")
    starttime = Cells(Rownumber, "i")
    endtime = Cells(Rownumber, "j")
    MsgBox date1
    
    'paste columns
    
    lengdest = lengdest + 1
    
    Workbooks(destinationbook).Worksheets(thissheetname).ListObjects(1).ListRows.Add
    
    Workbooks(destinationbook).Worksheets(thissheetname).Range("a" & lengdest) = chan
    Workbooks(destinationbook).Worksheets(thissheetname).Range("b" & lengdest) = eventtype & ": " & eventname
    Workbooks(destinationbook).Worksheets(thissheetname).Range("c" & lengdest) = date1
    Workbooks(destinationbook).Worksheets(thissheetname).Range("d" & lengdest) = starttime
    Workbooks(destinationbook).Worksheets(thissheetname).Range("e" & lengdest) = endtime


notransfer:
Next n
End Sub

This is the partially tidied code with the line highlighted that the debugger pointed to.

Rich (BB code):
Sub TRANSFERREQUESTS()
'
' TRANFEREQUEST Macro
'
Dim tbl As ListObject
Dim leng As Integer
Dim lengdest As Integer
Dim Rownumber As Integer
Dim chan As String
Dim eventtype As String
Dim eventname As String
Dim date1 As Date
Dim starttime As Date
Dim endtime As Date
Dim sourcebook As String
Dim destinationbook As String
Dim destrow As Integer
Dim thissheetname As String
destinationbook = Sheets("admin").Range("k6")
MsgBox destinationbook
thissheetname = ActiveSheet.Name


'find length of table
    Set tbl = ThisWorkbook.ActiveSheet.ListObjects(1)
    leng = tbl.DataBodyRange.Rows.Count
    
'find first paste row in destination book
    Set tbl = Workbooks(destinationbook).Worksheets(thissheetname).ListObjects(1)
    lengdest = tbl.DataBodyRange.Rows.Count + 3
    


For n = 1 To leng
    If ThisWorkbook.ActiveSheet.Range("T" & n + 3) <> "Y" Then GoTo notransfer
    
    
    'transfer columns
    
    ThisWorkbook.ActiveSheet.Range("T" & n + 3) = "R"
    
    'copy coloums
    Rownumber = n + 3
    chan = Cells(Rownumber, "c")
    date1 = Cells(Rownumber, "b")
    eventtype = Cells(Rownumber, "d")
    eventname = Cells(Rownumber, "e")
    starttime = Cells(Rownumber, "i")
    endtime = Cells(Rownumber, "j")
        
    'paste columns
    
    lengdest = lengdest + 1
    
    Workbooks(destinationbook).Worksheets(thissheetname).ListObjects(1).ListRows.Add
    
    Workbooks(destinationbook).Worksheets(thissheetname).Range("a" & lengdest) = chan
    Workbooks(destinationbook).Worksheets(thissheetname).Range("b" & lengdest) = eventtype & ": " & eventname
    Workbooks(destinationbook).Worksheets(thissheetname).Range("c" & lengdest) = date1
    Workbooks(destinationbook).Worksheets(thissheetname).Range("d" & lengdest) = starttime
    Workbooks(destinationbook).Worksheets(thissheetname).Range("e" & lengdest) = endtime


notransfer:
Next n
End Sub

In the first version i added the filename 'twelve.xlsm' manually but in the second i have used a variable, 'destinationbook' so i can point at a different bool easily. the msgbox confirms 'destinationbook' contains the full, correct name of the new destination sheet. I tried typing the filename in manualy, ("DEMORECBOOKINGFORM_1.XLSM") but that gives me 'runtime error 91; object variable or with block object not set' which the debugger says is:
lengdest = tbl.DataBodyRange.Rows.Count + 3

please, please, please can someone help?
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Hi,

Sorry, but it worked when I tried it. However, I had to guess at some things which you did not mention.

For instance, I used "twelve.xlsm" (without the quotes in K6) and created that workbook with a worksheet called "admin" that contained one valid Table.
As long as I opened that workbook first it ran correctly. If I misnamed anything I got a "Subscript Out Of Range" error.

I added some extra lines to see which part of the statement it failed on. You could try that to see if it helps:
Rich (BB code):
    'find first paste row in destination book
        Dim wb As Workbook
        Debug.Print vbLf; Now
        For Each wb In Workbooks
            Debug.Print wb.Name
        Next
        Set wb = Workbooks(destinationbook)
        Dim ws As Worksheet
        Set ws = wb.Worksheets(thissheetname)
        
        Set tbl = Workbooks(destinationbook).Worksheets(thissheetname).ListObjects(1)
        lengdest = tbl.DataBodyRange.Rows.Count + 3
Failing that, is there some kind of problem with the Table in destinationbook?

Sorry I can't be any more helpful.

Regards,
 
Upvote 0
thanks for your help, Rick. i'll try the code tomorrow.

the codeis in a module in the source book. 'admin' is a sheet in that book where k6 holds the name of the destination book.

the sheet with the table in the source book is called 'week_1' and the code copies a selection of data from there to a table on a sheet with the same name in the destination book, originally called twelve.xlsm but renamed as DEMORECBOOKINGFORM.xlsm.

my first code worked fine. it wasn't until i renamed things and used a variable - destinationbook - pointed at admin!k6 that the errors appeared.



Hi,

Sorry, but it worked when I tried it. However, I had to guess at some things which you did not mention.

For instance, I used "twelve.xlsm" (without the quotes in K6) and created that workbook with a worksheet called "admin" that contained one valid Table.
As long as I opened that workbook first it ran correctly. If I misnamed anything I got a "Subscript Out Of Range" error.

I added some extra lines to see which part of the statement it failed on. You could try that to see if it helps:
Rich (BB code):
    'find first paste row in destination book
        Dim wb As Workbook
        Debug.Print vbLf; Now
        For Each wb In Workbooks
            Debug.Print wb.Name
        Next
        Set wb = Workbooks(destinationbook)
        Dim ws As Worksheet
        Set ws = wb.Worksheets(thissheetname)
        
        Set tbl = Workbooks(destinationbook).Worksheets(thissheetname).ListObjects(1)
        lengdest = tbl.DataBodyRange.Rows.Count + 3
Failing that, is there some kind of problem with the Table in destinationbook?

Sorry I can't be any more helpful.

Regards,
 
Upvote 0
something bizarre has happened....

i just reloaded everything to check everything in detail and although i havent made any changes it ran perfectly.

mystified.
 
Upvote 0
Wasn't it Shakespeare that said: "All's well that ends well"?

Glad you got it sorted.

Regards,
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top