VBA to save file as values not always working

[woodsy74]

I have a macro button that opens up an excel template file, calculates it, saves it to a new location, copies all of the cells & pastes values, and then saves the file again. This is done for about 15 files. My issue is that sometimes when I run the macro button I will find one or two or three files that still have formulas in them and they are not values. It's not the same files that have this issue either. One time when I run it will be the 3rd and 5th files that still have formulas. The next time I run it the 8th file still has formulas. I've had other folks run this macro and so far when they've run it all of the files look good. Is there a setting or something that I need to adjust for this to work on all the files for me?

Here's the code:
Workbooks.Open Filename:="S:\FILE.xlsx", UpdateLinks:=3
ActiveWorkbook.Save

ActiveWorkbook.SaveAs Filename:="S:\FILE_NEW.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save


ActiveWorkbook.Close

 

[DanteAmor]

I do not see in your macro the updates and best proposals in the macro of post #7 .
Make the changes and try again.

Note: The copy of values ​​only applies to sheet1. If you need it for all the sheets, you could specify it in the requirements, otherwise we are only guessing.

 

[MoshiM]

Have you tried any of the provided macros? If you have and they do not do what you want, then please tell us what it does wrong?

Here is another Macro that will loop through all your files assuming:
You are dealing with .xlsx files
The opened template is named Abbreviation+space+(North or West or South[Note : The ability to add more is available.]).xlsx. Example GH West.xlsx
You have a folder with the Abbreviation on your S drive
You want the saved file to have the name: Abbreviation_ POSTED

You can add other abbreviations to the array.

If this is not what you want, then one of the earlier macros can be easily repurposed to suit your needs.
Please read the comments. I've done my best to document what each line does so if it does something you don't want it to do then point it out.

Sub Values_Only_Template()


Dim WB As Workbook, WR As Range, Values_Only As Variant, File_String() As String, X As Long, Workbook_Name As String, ABR() As String, Y As Long, Z As Byte


Application.DisplayAlerts = False
Application.ScreenUpdating = False


ABR = Split("TR", ",") '[COLOR=#ff0000]Abbreviations go here separated by a comma.[/COLOR] [COLOR=#ff0000]Start addition immediately after TR[/COLOR]


File_String = Split("North,South,West", ",") '[COLOR=#ff0000]Stuff that will come after the abbreviation. Same rules as above if there are more[/COLOR]


For Y = 0 To UBound(ABR) '[COLOR=#008000]Loop through Abbreviations.            Array starts at 0[/COLOR]


    Z = 0
    
    For X = 0 To UBound(File_String)'[COLOR=#008000]Loop through Name additions[/COLOR]
        
        '[COLOR=#ff0000]Template to be opened will be the current abbreviation + current File_String[/COLOR] [Example] for the        [COLOR=#800080]1st loop[/COLOR]  [COLOR=#800080]TR North.xlsx[/COLOR]
                                                                                                          '[COLOR=#800080]2nd       TR South.xlsx[/COLOR]
[COLOR=#800080]                                                                                                          '3rd        TR West.xlsx[/COLOR]
                                                                                                                                                         
        Workbook_Name = "S:\" & ABR(Y) & "\" & ABR(Y) & " " & File_String(X) & ".xlsx"          '[COLOR=#0000ff][Example] [/COLOR]"[COLOR=#ff0000]S:\TR\TR West.xlsx[/COLOR]"
        
        If Dir(Workbook_Name) <> "" Then '[COLOR=#0000ff]If the Template exists then run the code below[/COLOR]
            
            Z = 1'[COLOR=#ff0000]message box will be displayed at the end of loop if the current abbreviation exists[/COLOR]
    
            Set WB = Workbooks.Open(Workbook_Name, UpdateLinks:=3) '[COLOR=#0000ff]open template and store reference to it in variable WB[/COLOR]
        
            With WB
        
                Set WR = .Worksheets(1).UsedRange '[COLOR=#0000ff]create reference to usedrange on first worksheet within template[/COLOR]
[COLOR=#0000ff]                               .Save 'save original template with updated links,calculations etc[/COLOR]
            End With
            'do you really need the above .save line?
        
            With WR '[COLOR=#0000ff]with range object[/COLOR]
        
                 Values_Only = .Value '[COLOR=#0000ff]place template values in an array[/COLOR]
        
                .Value = Values_Only '[COLOR=#0000ff]Overwrite cells on worksheet 1 of template with the array[/COLOR]
        
            End With
        
            With WB
        
                Workbook_Name = Replace(Workbook_Name, ABR(Y), ABR(Y) & "_POSTED", 1, 1) '[COLOR=#0000ff][Example][/COLOR] "[COLOR=#ff0000]S:\TR\TR West.xlsx[/COLOR]"[COLOR=#0000ff]------>[/COLOR]"[COLOR=#ff0000]S:\TR_POSTED\TR West.xlsx[/COLOR]"
                                                                                               '[COLOR=#0000ff][Example Explanation][/COLOR] [COLOR=#008000]replace first instance of TR with TR_POSTED[/COLOR]
                .SaveAs Filename:=Workbook_Name, _
                        FileFormat:=xlOpenXMLWorkbook, _
                        Password:="", _
                        WriteResPassword:="", _
                        ReadOnlyRecommended:=False, _
                        CreateBackup:=False '[COLOR=#0000ff]save new version of  template(values only) with a different name & location[/COLOR]
        
                .Close '[COLOR=#0000ff]Close new workbook (values only)[/COLOR]
        
            End With
        
        End If
    
    Next X'[COLOR=#ff0000]Next name addition if available[/COLOR]
    
    If Z = 1 Then MsgBox ABR(Y) & "Post finished"
                    '[Example] TR
Next Y '[COLOR=#ff0000]go to next abbreviation if available[/COLOR]


Application.ScreenUpdating = True
Application.DisplayAlerts = True
   
End Sub

 

[woodsy74]

I've updated the code to the following. I ran the macro twice. The 1st time North was saved with formulas but the other two files were good. The 2nd time I ran the macro West was saved with formulas but the other two files were good.

Sub TR_Post_Rates()

Application.DisplayAlerts = False

Dim w1 As Workbook, sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False



'''----TR North---'''
Set w1 = Workbooks.Open(Filename:="S:\TR\TR North.xlsx", UpdateLinks:=3)
w1.Save

w1.SaveAs Filename:="S:\TR_POSTED\TR North.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Set sh = w1.Sheets(1)
sh.Cells.Copy
sh.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
w1.Save
w1.Close False

'''----TR North---'''

'''----TR South---'''
Set w1 = Workbooks.Open(Filename:="S:\TR\TR South.xlsx", UpdateLinks:=3)
w1.Save

w1.SaveAs Filename:="S:\TR_POSTED\TR South.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Set sh = w1.Sheets(1)
sh.Cells.Copy
sh.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
w1.Save
w1.Close False


'''----TR South---'''


'''----TR West---'''
Set w1 = Workbooks.Open(Filename:="S:\TR\TR West.xlsx", UpdateLinks:=3)
w1.Save

w1.SaveAs Filename:="S:\TR_POSTED\TR West.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Set sh = w1.Sheets(1)
sh.Cells.Copy
sh.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
w1.Save
w1.Close False


'''----TR West---'''


Application.ScreenUpdating = True


MsgBox "TR Post Finished"

End Sub

 

[woodsy74]

MoshiM, I used the code you provided in post #12 . So far it seems to be working. I ran it through 5 times and each time all 3 files were correctly saved as values. I just need to look at your code a little bit further. All of the templates are located in the same folder but the filenames do not all start out the same. And, all of the files are not saved out to the same "posted" folder.

Again, I do not understand why my original code does not always work. It's like sometimes it decides to skip lines or something.

Anyway, thanks all for your help. I will let you know if I have issues with the code you provided.

 

[DanteAmor]

I updated your macro, in theory you should not modify it, please try again.

Note: I repeat, the procedure only converts the data on sheet1 into values.

Sub TR_Post_Rates()
  Dim w1 As Workbook, sh As Worksheet
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  '''----TR North---'''
  Set w1 = Workbooks.Open(Filename:="S:\TR\TR North.xlsx", UpdateLinks:=3)
  Set sh = w1.Sheets(1)
  sh.Cells.Copy
  sh.Range("A1").PasteSpecial Paste:=xlPasteValues
  w1.SaveAs Filename:="S:\TR_POSTED\TR North.xlsx"
  w1.Close False
  '''----TR South---'''
  Set w1 = Workbooks.Open(Filename:="S:\TR\TR South.xlsx", UpdateLinks:=3)
  Set sh = w1.Sheets(1)
  sh.Cells.Copy
  sh.Range("A1").PasteSpecial Paste:=xlPasteValues
  w1.SaveAs Filename:="S:\TR_POSTED\TR South.xlsx"
  w1.Close False
  '''----TR West---'''
  Set w1 = Workbooks.Open(Filename:="S:\TR\TR West.xlsx", UpdateLinks:=3)
  Set sh = w1.Sheets(1)
  sh.Cells.Copy
  sh.Range("A1").PasteSpecial Paste:=xlPasteValues
  w1.SaveAs Filename:="S:\TR_POSTED\TR West.xlsx"
  w1.Close False
  MsgBox "TR Post Finished"
End Sub

-----------------------------------------
If you execute the macro step by step after this point the formulas (on sheet 1) should be as values.-

sh.Range("A1").PasteSpecial Paste:=xlPasteValues

---------------------------
If it works, I put the reduced macro.

Sub TR_Post_Rates2()
  Dim w1 As Workbook, sh As Worksheet, files As Variant, i As Long
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
[COLOR=#0000ff]  files = Array("TR North.xlsx", "TR South.xlsx", "TR West.xlsx")[/COLOR]
  For i = 0 To UBound(files)
    Set w1 = Workbooks.Open(Filename:="S:\TR\" & files(i), UpdateLinks:=3)
    Set sh = w1.Sheets(1)
    sh.Cells.Copy
    sh.Range("A1").PasteSpecial Paste:=xlPasteValues
    w1.SaveAs Filename:="S:\TR_POSTED\" & files(i)
    w1.Close False
  Next
  MsgBox "TR Post Finished"
End Sub