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!
 
Sort by date Sort by votes
Ok, very strange... I will blame it on company security settings then, I guess, because here I keep running into the same error message :confused:
In the meantime I've set up the file with a slight change so users need to click 2 buttons to see both sheets and this seems to work.
Many thanks for your help!
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
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
77
Cubist
Cubist
S
  • Solved
Copy hyperlinks from one table column to another. The columns are identical
Replies
2
Views
57
sspatriots
S
W
  • Question
VBA InputBox without entry quitting Sub/Macro
Replies
1
Views
111
Micron
M
D
  • Solved
Run-time error '1004': Application-defined or object-defined error
Replies
4
Views
480
rollis13
rollis13
A
  • Solved
Application-defined or object defined Error when Filtering Listbox
Replies
4
Views
142
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,951
Messages
6,122,442
Members
449,083
Latest member
Ava19

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