Run Time Error 1004: PasteSpecial method of Range class failed ...

0

Hi guys,

So I've Spent about 2 weeks trying to figure this error out and am simply tired of it. Any help will be appreciated. So I have a code the copies rows from a sheet 'Workings' to another sheet called template one at a time. Its paste special xlvalues. Now this is where it get weird. The first time I execute the macro it all runs perfectly fine. When I try to run it immediately after for the second time, it comes up with Run Time Error 1004: PasteSpecial method of Range class failed. Now none of my cells are merged in either of the sheets. The paste special code is immediately after it copies the data. It run s perfectly well as long as I keep closing and reopening the workbook each time after the execution of the Macro. Here is the code below. Mind you this is a part of a bigger macro.

Sub Select_MP(MP_product_code_AWP, MP_file_type_AWP, MP_product_code_CWP, MP_file_type_CWP, MP_product_code_WPIA, MP_file_type_WPIA)
Dim product_code_column As Integer
Dim elaps_mon_column As Integer
Dim prod_range As Range
Dim elaps_range As Range
Dim j As Double
'Calculate what column prod_code is in the mp s/s
Range("A1").Select
product_code_column = 0
For Each prod_range In Range(Selection, Selection.End(xlToRight))
    If (prod_range.Value = "prod_code") Then
    product_code_column = prod_range.Column
    product_code_column = product_code_column - 1
    End If
Next
'Calculate what column prod_code is in the mp s/s
Range("A1").Select
elaps_mon_column = 0
For Each elaps_range In Range(Selection, Selection.End(xlToRight))
    If (elaps_range.Value = "elaps_mon") Then
    elaps_mon_column = elaps_range.Column
    elaps_mon_column = elaps_mon_column - 1
    End If
Next
'Set the offset to 1 for the while loop
j = 1
   
'Loop through every model point in the workings sheet
Do While wks_workings.Range("A1").Offset(j, 0).Value <> Empty
    If Left(wks_workings.Range("A1").Offset(j).Value, 3) = "AWP" Then
   
        'If the product Code matches and elaps months matches
        If wks_workings.Range("A1").Offset(j, product_code_column).Value = MP_product_code_AWP Then
            If MP_file_type_AWP = "IF" Then
                If wks_workings.Range("A1").Offset(j, elaps_mon_column).Value > 0 Then
                    wks_workings.Rows(j + 1).Copy
                    wks_template_AWP.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
                    Application.CutCopyMode = False
                End If
           
            ElseIf MP_file_type = "NB" Then
                If wks_workings.Range("A1").Offset(j, elaps_mon_column).Value <= 0 Then
                    wks_workings.Rows(j + 1).Copy
                    wks_template_AWP.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
                    Application.CutCopyMode = False
                End If
            End If
        End If
    End If
                  
'Move on to next model point
    j = j + 1
Application.CutCopyMode = False
   
Loop
   
End Sub

I have declared all the the variables, strings etc.

Any help will be appreciated. Let me know if any more information would help.

Thanks in advance.

***Edit

The module that pulls through the above code is as below:

Sub Join_Files_AWP()
'Define all variables that are to be used in the macro.
Dim original_file_name As String
Dim MP_product_code_AWP As String
Dim MP_file_type_AWP As String
Dim MP_file_path_AWP As String
Dim output_file_path_AWP As String
Dim i As Integer
Dim msg_string As String
Dim Start As Date
Dim output_file_name_AWP As String
Dim restrictedspreadsheet As String
Start = Now()

'Setting the Excel calculation mode to manual and turning off screen updating to increase speed.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Set the full file path of the tool and output files
original_file_name = Application.ActiveWorkbook.Name
output_file_name_AWP = wks_inputs.Range("Output_File_Name_AWP").Value
output_file_path_AWP = wks_inputs.Range("Output_Dir_AWP").Value & output_file_name_AWP & ".csv"
'Warning message that the output path does not exist
If Range("Output_Dir_AWP").Value = Empty Then
    msg_string = "Please enter the output file path in for AWP model point."
    MsgBox (msg_string)
    Exit Sub
End If
'Warning message that the output path does not exist
If Dir(Range("Output_Dir_AWP").Value) = "" Then
    msg_string = "The output file path specified for AWP model point does not exist. Please enter the correct output file path."
    MsgBox (msg_string)
    Exit Sub
End If
'Warning message that the output path does not exist
If output_file_name_AWP = Empty Then
    msg_string = "Please specify a file name in cell C10 before proceeding."
    MsgBox (msg_string)
    Exit Sub
End If
'Warning message that if the output file already exists it will be overwritten
msg = "Before running the 'Join Files' macro, note that;" & vbCrLf
msg = msg & vbCrLf & Chr(149) & " If the output file " & output_file_path_AWP & " already exists it will be overwritten."
msg = msg & vbCrLf & vbCrLf & Chr(149) & " This spreadsheet will save automatically at the end of the import."
msg = msg & vbCrLf & vbCrLf & " Do you want to continue?"
Check = MsgBox(msg, vbYesNo)
If Check = vbNo Then
    MsgBox "User abandoned model point creation.", vbCritical + vbOKOnly
    Exit Sub
End If
'Delete csv file if it already exists
If Len(Dir$(output_file_path_AWP)) > 0 Then
     Kill output_file_path_AWP
End If
'Set the offset to 1 for the while loop and the offset lookups for product code and elaps_mon
i = 1
'Keep running the while loop whilst there is a value for a file path
Do While wks_inputs.Range("File_Location_AWP").Offset(i, 0).Value <> Empty
    MP_product_code_AWP = wks_inputs.Range("Product_Code_AWP").Offset(i, 0).Value
    MP_file_type_AWP = wks_inputs.Range("IF_NB_AWP").Offset(i, 0).Value
    MP_file_path_AWP = wks_inputs.Range("File_Location_AWP").Offset(i, 0).Value & wks_inputs.Range("File_Name_AWP").Offset(i, 0).Value
        
    If Dir(MP_file_path_AWP) = Empty Then
        msg_string = "Cannot find model points for " & MP_product_code_AWP & " " & MP_file_type_AWP & " business (" & MP_file_path_AWP & ")."
        MsgBox (msg_string)
        Exit Sub
    End If
         
    Application.StatusBar = "Adding " & MP_product_code_AWP & " " & MP_file_type_AWP & " model points."
         
'Open the model point file and copy all the contents
Workbooks.Open Filename:=MP_file_path_AWP
ActiveCell.CurrentRegion.Copy
                    
'Paste the content to the Workings sheet of the MP joiner
Windows(original_file_name).Activate
wks_workings.Activate
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
'Close the model point file
Application.CutCopyMode = False
Windows(wks_inputs.Range("File_Name_AWP").Offset(i, 0).Value).Activate
ActiveWorkbook.Close savechanges:=False
                    
'Select the MP joiner file Workings sheet
Windows(original_file_name).Activate
wks_workings.Activate
                 
'Call select_MP module which will go through workings sheet and paste to template the relevant model points
Call Select_MP(MP_product_code_AWP, MP_file_type_AWP, MP_product_code_CWP, MP_file_type_CWP, MP_product_code_WPIA, MP_file_type_WPIA)
                
'Delete the model points in the Workings sheet
wks_workings.Activate
ActiveCell.CurrentRegion.Clear
    
i = i + 1
ThisWorkbook.Save
 
Loop
restrictedspreadsheet = "\\Ukact22\Data_ukact_wpm\Modelling\Tool_Development\Boldon_James_Classified_Templates\Restricted_Blank_Template.xlsx"
'Open the Bolden James Restricted classified spreadsheet and save as new csv file
Workbooks.Open restrictedspreadsheet, ReadOnly:=True
ActiveWorkbook.SaveAs Filename:=output_file_path_AWP, FileFormat:= _
    xlCSV, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False
'Save template to csv file
Call Savetonew(original_file_dir, original_file_name, output_file_name_AWP, output_file_name_CWP, output_file_name_WPIA)
Application.CutCopyMode = False
'Update audit information
Range("Audit_User_AWP").Value = Application.UserName
Range("Audit_Date_AWP").Value = Start
Range("Audit_Time_AWP").Value = Now() - Start
Range("Audit_Output_AWP").Value = output_file_path_AWP
'Delete the model points in the template sheet
wks_template_AWP.Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Clear
'Select inputs sheet and save workbook
Application.DisplayAlerts = False
wks_audit.Activate
ActiveWorkbook.Save
'Success message
Application.StatusBar = False
MsgBox ("AWP model point file creation has been successful.")
End Sub
Answer
Discuss

Discussion

Im not at my computer right now so i cant test it but usually it is helpful to include the full macro in which this code is placed as that usually affects the code in question.
don (rep: 1482) Mar 31, '17 at 1:46 am
Ahhh ok, read the rules please. You need to update your question with that info by editing it and not just posting it in the discussion section - its hard to read and follow down here and thats why there is a text length limit here.
don (rep: 1482) Mar 31, '17 at 5:48 am
Hope that helps. Sorry again I literally just made an account to ask a question. I have just started using VBA and have no training so it may be  the simplest thing that might be setting it off.
rberiya Mar 31, '17 at 5:55 am
You can't include a sample file can you?
cappymer1 (rep: 120) Apr 1, '17 at 11:57 pm
Did the solution work for you? Make sure to select the answer or add a comment to get further assistance.
cappymer1 (rep: 120) Apr 10, '17 at 12:19 pm
Add to Discussion

Answers

0

Sorry for the late reply!

What I would try is to change how you are transferring/copying the values.

Instead of using PasteSpecial like this:

wks_workings.Rows(j + 1).Copy
wks_template_AWP.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False

Just transfer the values from one sheet to another using this kind of setup/method:

wks_template_AWP.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = wks_workings.Rows(j + 1).Value

This way, you just use the simple method Range("A1").Value (example cell reference used) to get the visible value of a cell.

Discuss

Discussion

Hi,

The solution didnt work for me. I started the entire code from scratch on a new workbook. I didnt change any code, I just took a fresh workbook and copy pasted my code into it and it worked.

I dont know what was wrong but that did the job.
rberiya Apr 10, '17 at 12:22 pm
Thanks for the update! Can you please post that as an Answer to this question so it can help other people in the future when they visit the forum.
don (rep: 1482) Apr 12, '17 at 5:50 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login