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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
You must log in or register to reply here.

Similar threads

PIsabel
  • Question Question
Change prices
Replies
3
Views
73
smozgur
smozgur
O
  • Question Question
User-defined type not defined - vba/excel error
Replies
4
Views
214
RoryA
RoryA
I
  • Solved
Simplify my working code please
Replies
7
Views
166
ipbr21054
I
I
  • Question Question
Value not shown in ComboBox1 when code run
Replies
1
Views
54
ipbr21054
I
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
77
howard
H

Forum statistics

Threads
1,223,909
Messages
6,175,312
Members
452,634
Latest member
cpostell

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