runtime error 1004 application-defined or object-defined error with second macro

M

Mouzty

New Member
Joined
May 6, 2016
Messages
6
Hi,

This forum has helped me already quite a bit in the past just by reading up on threads from other users, but with this error I can't seem to find any solution.
Hope you guys can help and this is just a 'rookie mistake' or something...

I have 2 very similar macro's that each copy information from the same sheet and paste this information into other sheets.
When I run the macro's separately they both do what they're supposed to, but when they're called from another macro one after the other I get the runtime error 1004 application-defined or object-defined error while running the second macro.

These are both macro's:

Rich (BB code): 
Sub ShowCost()
    'Macro to copy data from sheet "Internal use only", but only show lines that are marked "X" in column A "OK"
    
    Worksheets("Cost Sheet").Select
    Worksheets("Cost Sheet").Range("A:T").Clear
    
'1st step: copy the data in the correct order
    Worksheets("Internal use only!!!").Range("D:D,H:H").Copy
    Worksheets("Cost Sheet").Range("A1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("F:F,P:P,Q:Q").Copy
    Worksheets("Cost Sheet").Range("C1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("O:O").Copy
    Worksheets("Cost Sheet").Range("F1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("L:L,AZ:AZ").Copy
    Worksheets("Cost Sheet").Range("G1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("AY:AY,BD:BD,BE:BE").Copy
    Worksheets("Cost Sheet").Range("I1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("G:G,I:I,K:K").Copy
    Worksheets("Cost Sheet").Range("L1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("J:J,M:M,BA:BA").Copy
    Worksheets("Cost Sheet").Range("O1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("AR:AR,BF:BF,BG:BG").Copy
    Worksheets("Cost Sheet").Range("R1").PasteSpecial Paste:=xlValues
   
'2nd step: add hyperlinks
    Dim integ As Integer
    Dim strng As String

    For integ = 2 To Range("R2", Range("R2").End(xlDown)).Cells.SpecialCells(xlCellTypeLastCell).Row
        strng = Trim(Range("R" & CStr(integ)).Text)
        ActiveCell.Hyperlinks.Add Range("R" & CStr(integ)), strng, , , "Visual"
    Next integ

'3rd step: delete all rows that have a blank cell in column A
    Worksheets("Cost Sheet").Range("A:A"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
'4th step: layout as table
    Dim tbl As ListObject
    Dim rng As Range

    Range("A1", Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
    Set rng = Selection
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium15"
    Worksheets("Cost Sheet").Cells.Select
    Selection.Columns.AutoFit
        
'4th step: change column headers, delete column A with "x" and autofit column width
    With Worksheets("Cost Sheet")
        .[B1] = "Title1"
        .[C1] = "Title2"
        .[D1] = "Title3"
        .[E1] = "Title4"
        .[F1] = "Title5"
        .[G1] = "Title6"
        .[H1] = "Title7"
        .[I1] = "Title8"
        .[J1] = "Title9"
        .[K1] = "Title10"
        .[L1] = "Title11"
        .[M1] = "Title12"
        .[N1] = "Title13"
        .[O1] = "Title14"
        .[P1] = "Title15"
        .[Q1] = "Title16"
        .[R1] = "Title17"
        .[S1] = "Title18"
        .[T1] = "Title19"
        Columns(1).EntireColumn.Delete

    End With
  
End Sub

Rich (BB code): 
Sub ShowCDO()
    'Macro to copy data from sheet "Internal use only", but only show lines that are marked "X" in column A "OK"
    
    Worksheets("CDO Sheet").Select
    Worksheets("CDO Sheet").Range("A:AD").Clear
    
    
'1st step: copy the data in the correct order
    Worksheets("Internal use only!!!").Range("E:E,P:P,Q:Q").Copy
    Worksheets("CDO Sheet").Range("A1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("Z:Z,AD:AD,AH:AH,AL:AL,AP:AP").Copy
    Worksheets("CDO Sheet").Range("J1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("K:K").Copy
    Worksheets("CDO Sheet").Range("W1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("G:G,J:J").Copy
    Worksheets("CDO Sheet").Range("X1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("I:I,L:L,M:M,BA:BA").Copy
    Worksheets("CDO Sheet").Range("Z1").PasteSpecial Paste:=xlValues
    Worksheets("Internal use only!!!").Range("AR:AR").Copy
    Worksheets("CDO Sheet").Range("AD1").PasteSpecial Paste:=xlValues
   
'2nd step: add hyperlinks to picture database
    Dim integ As Integer
    Dim strng As String

    For integ = 2 To Range("AD2", Range("AD2").End(xlDown)).Cells.SpecialCells(xlCellTypeLastCell).Row
        strng = Trim(Range("AD" & CStr(integ)).Text)
        ActiveCell.Hyperlinks.Add Range("AD" & CStr(integ)), strng, , , "Visual"
    Next integ

'3rd step: delete all rows that have a blank cell in column A
    Worksheets("CDO Sheet").Range("A:A"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
'4th step: add information based on formulas
    Dim LastRow As Range
        
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    With Worksheets("CDO Sheet")
        .[D2].Formula = "=VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""HNL Filling Cost"",Table1310[[#Headers],[Item code]:[HNL filling cost]],0),FALSE)+IFERROR(IF(SEARCH(""12W"",C2)>0,'Internal use only!!!'!$J$4),IFERROR(IF(SEARCH(""F4"",C2)>0,'Internal use only!!!'!$J$5),IFERROR(IF(SEARCH(""CFD"",C2)>0,IFERROR(IF(SEARCH(""PR"",C2)>0,'Internal use only!!!'!$J$6),'Internal use only!!!'!$J$7)),IFERROR(IF(SEARCH(""BFD"",C2)>0,'Internal use only!!!'!$J$8),0))))"
        .[E2].Formula = "=VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""L/C"",Table1310[[#Headers],[Item code]:[L/C]],0),FALSE)*IFERROR(IF(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""# comp 1"",Table1310[[#Headers],[Item code]:['# comp 1]],0),FALSE)=1,IFERROR(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""# AA"",Table1310[[#Headers],[Item code]:['# AA]],0),FALSE),0)+IFERROR(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""# AAA"",Table1310[[#Headers],[Item code]:['# AAA]],0),FALSE),0)+IFERROR(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""# D"",Table1310[[#Headers],[Item code]:['# D]],0),FALSE),0)+IFERROR(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""# C"",Table1310[[#Headers],[Item code]:['# C]],0),FALSE),0)+IFERROR(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""9V"",Table1310[[#Headers],[Item code]:['# 9V]],0),FALSE),0),1),1)"
        .[F2].Formula = "=SUM(D2:E2)"
        .[G2].Formula = "=E2+IFERROR(IF(INDEX(Table1310[Brand],MATCH(B2,Table1310[Item code],0))=""Premio"",D2,0),0)"
        .[H2].Formula = "=SUM(J2:N2)"
        .[I2].Formula = "=J2/H2"
        .[P2].Formula = "=IFERROR(J2/AA2, J2/INDEX(Table1310[Packaging Qty],MATCH(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""Code comp 1"",Table1310[[#Headers],[Item code]:[Code comp 1]],0),FALSE),Table1310[Item code],0)))"
        .[Q2].Formula = "=IFERROR(K2/AA2, K2/INDEX(Table1310[Packaging Qty],MATCH(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""Code comp 2"",Table1310[[#Headers],[Item code]:[Code comp 2]],0),FALSE),Table1310[Item code],0)))"
        .[R2].Formula = "=IFERROR(L2/AA2, L2/INDEX(Table1310[Packaging Qty],MATCH(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""Code comp 3"",Table1310[[#Headers],[Item code]:[Code comp 3]],0),FALSE),Table1310[Item code],0)))"
        .[S2].Formula = "=IFERROR(M2/AA2, M2/INDEX(Table1310[Packaging Qty],MATCH(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""Code comp 4"",Table1310[[#Headers],[Item code]:[Code comp 4]],0),FALSE),Table1310[Item code],0)))"
        .[T2].Formula = "=IFERROR(N2/AA2, N2/INDEX(Table1310[Packaging Qty],MATCH(VLOOKUP(B2,'Internal use only!!!'!P:BP,MATCH(""Code comp 5"",Table1310[[#Headers],[Item code]:[Code comp 5]],0),FALSE),Table1310[Item code],0)))"
        .[O2].Formula = "=SUM(P2:T2)"
        .[U2].Formula = "=D2/H2"
        .[V2].Formula = "=F2/H2"
        .Range("D2:I" & LastRow).FillDown
        .Range("O2:V" & LastRow).FillDown
    End With
         
'5th step: layout as table
    Dim tbl As ListObject
    Dim rng As Range

    Range("A1", Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
    Set rng = Selection
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium15"
    Worksheets("CDO Sheet").Cells.Select
    Selection.Columns.AutoFit
    
    Worksheets("CDO Sheet").Columns("I").Select
    Selection.NumberFormat = "0.00%"
    
    Worksheets("CDO Sheet").Columns("D:G").Select
    Selection.NumberFormat = "0.0000"
    
    Worksheets("CDO Sheet").Columns("U:V").Select
    Selection.NumberFormat = "0.0000"
        
'6th step: change column headers, delete column A with "x" and autofit column width
    With Worksheets("CDO Sheet")
        .[B1] = "Title1"
        .[C1] = "Title2"
        .[D1] = "Title3"
        .[E1] = "Title4"
        .[F1] = "Title5"
        .[G1] = "Title6"
        .[H1] = "Title7"
        .[I1] = "Title8"
        .[J1] = "Title9"
        .[K1] = "Title10"
        .[L1] = "Title11"
        .[M1] = "Title12"
        .[N1] = "Title13"
        .[O1] = "Title14"
        .[P1] = "Title15"
        .[Q1] = "Title16"
        .[R1] = "Title17"
        .[S1] = "Title18"
        .[T1] = "Title19"
        .[U1] = "Title20"
        .[V1] = "Title21"
        .[W1] = "Title22"
        .[X1] = "Title23"
        .[Y1] = "Title24"
        .[Z1] = "Title25"
        .[AA1] = "Title26"
        .[AB1] = "Title27"
        .[AC1] = "Title28"
        .[AD1] = "Title29"
        Columns(1).EntireColumn.Delete

    End With
    
End Sub

The first macro always runs, but the second always provides the error on the bold lines when the first bit of information has to be copy-pasted.

Many thanks in advance for your feedback!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Welcome to the forum.

Just for completeness, can you post the code that calls these two?
 
Upvote 0
RoryA said:
Welcome to the forum.

Just for completeness, can you post the code that calls these two?
Click to expand...

Thanks!

This is the third macro, it runs when you click on a button in the first sheet "Strictly confidential".

Code: 
Sub Unhide()
'
' Unhide Macro
'
' Keyboard Shortcut: Ctrl+u
'
    ActiveWorkbook.Unprotect
    Sheets("Cost Sheet").Visible = True
    Sheets("Cost Sheet").Select
    ShowCost
    Sheets("CDO Sheet").Visible = True
    Sheets("CDO Sheet ").Select
    ShowCDO
    Sheets("Strictly confidential").Select
End Sub
 
Upvote 0
Do you really have a sheet called "CDO Sheet " (with a space at the end) as well as "CDO Sheet"?
 
Upvote 0
RoryA said:
Do you really have a sheet called "CDO Sheet " (with a space at the end) as well as "CDO Sheet"?
Click to expand...

No, I changed the names just to post online. It's a typo in this post, not in the actual code :)
So only 1 sheet!
 
Upvote 0
I can't see anything wrong with the code. Do you have any event code in the workbook, such as Worksheet_Activate or Deactivate events?
 
Upvote 0
All the code is listed in previous posts...

Both macro's do exactly what I want when I run them seperately, but one after the other is causing a problem; always for the second macro :(

If no solution I will work around it and try something where users have to click two buttons instead of one.

Thanks!
 
Upvote 0
Can you post a workbook somewhere (OneDrive / Dropbox / other sharing site) and put a link here so I can check what is happening?
 
Upvote 0
I'm afraid I can't reproduce the error with that file. It works fine.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA set conditional formatting application-defined or object-defined error
Replies
3
Views
98
Cubist
Cubist
S
  • Solved
Copy hyperlinks from one table column to another. The columns are identical
Replies
2
Views
95
sspatriots
S
W
  • Question
VBA InputBox without entry quitting Sub/Macro
Replies
1
Views
126
Micron
M
D
  • Solved
Run-time error '1004': Application-defined or object-defined error
Replies
4
Views
493
rollis13
rollis13
A
  • Solved
Application-defined or object defined Error when Filtering Listbox
Replies
4
Views
155
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,453
Messages
6,124,918
Members
449,195
Latest member
Stevenciu

Share this page

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