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

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
You must log in or register to reply here.

Similar threads

I
  • Question Question
Unable to run VBA code
Replies
6
Views
165
RoryA
RoryA
T
  • Question Question
My Array is returning an Internal Error - but not stopping the macro
Replies
3
Views
79
NdNoviceHlp
NdNoviceHlp
PIsabel
  • Question Question
Change prices
Replies
3
Views
87
smozgur
smozgur
O
  • Question Question
User-defined type not defined - vba/excel error
Replies
4
Views
296
RoryA
RoryA
V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
124
vanessavalentino83
V

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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