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