Create Files Streamline code

[Biz]

Dear All,

I have code that works but it is very slow about 5mins.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
It is creating 170 new files from current template and it runs vba in new files where it paste special values and removes all vba from New file and save it closes file.<o></o>

Sub Createfiles()
    Dim r As Range, myDir As String
    Dim ActBook As Workbook, NewBook As Workbook
    Dim aStartTime
    aStartTime = Now()
    
    'Speeding Up VBA Code
    Application.ScreenUpdating = False 'Prevent screen flickering
    Application.Calculation = False 'Preventing calculation
    Application.DisplayAlerts = False 'Turn OFF alerts
    Application.EnableEvents = False 'Prevent All Events
    Application.DisplayStatusBar = False
    
    
    Set ActBook = ActiveWorkbook
    myDir = "c:\Temp\"
    With Sheets("BUs")
        For Each r In .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            If Not IsEmpty(r) Then
                With Sheets("2006-07")
                    .Range("b1") = r.Value
                End With
                ThisWorkbook.SaveCopyAs (myDir & "BU " & r.Value & ".xls")
                
                'Open New File created
                Workbooks.Open Filename:=myDir & "BU " & r.Value & ".xls", UpdateLinks:=3
                Set NewBook = ActiveWorkbook
                
                Application.Run "'BU " & r.Value & ".xls'" & Chr(33) & "SPaste"
                Application.Run "'BU " & r.Value & ".xls'" & Chr(33) & "DeleteAllVBA"
                
                'Save New workbook after doing Paste Special values and Removing VBA
                With NewBook
                    .Save
                    .Close
                End With
                
                ActBook.Activate
            End If
        Next
    End With
    
    'Release memory
    Set ActBook = Nothing
    Set NewBook = Nothing
    
    'Speeding Up VBA Code
    Application.ScreenUpdating = True 'Prevent screen flickering
    Application.Calculation = True 'Preventing calculation
    Application.DisplayAlerts = True 'Turn OFF alerts
    Application.EnableEvents = True 'Prevent All Events
    Application.DisplayStatusBar = True
    
    MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss"), vbInformation, "Time taken"
    
End Sub
Sub SPaste()
    With Sheets("2006-07").Range("D5:P156")
        .Value = .Value
    End With
End Sub
 
Sub DeleteAllVBA()
'Dim VBComp As VBIDE.VBComponent
'Dim VBComps As VBIDE.VBComponents
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
   Select Case VBComp.Type
      Case vbext_ct_StdModule, vbext_ct_MSForm, _
            vbext_ct_ClassModule
         VBComps.Remove VBComp
      Case Else
         With VBComp.CodeModule
            .DeleteLines 1, .CountOfLines
         End With
   End Select
Next VBComp
End Sub

Is there a faster way to do this?

Biz

 

[TryingToLearn]

I'm impressed that it's only taking 5 minutes. Do you realize you are physically saving 170 files to your hard disk in less than 2 seconds each?

 

[Biz]

I'm impressed that it's only taking 5 minutes. Do you realize you are physically saving 170 files to your hard disk in less than 2 seconds each?

You are right but there is always a better way. I don't mind if someone can show me faster way. Learnt a lot from Forum and advice I got here was magnificent.

Biz

 

[Jerry Sullivan]

Hi Biz,

I haven't throughly studied your code, but it at a glance it looks like you best potential to save time would be to Copy the Worksheet(s) that you want to a new workbook instead of doing SaveCopyAs. This would save you from having to reopen the file to do your next step in the process.

Post #5 of this thread from earlier today shows an example with one sheet being copied, and you could do the same with an array of sheets.
http://www.mrexcel.com/forum/showthread.php?t=588551

If that part works for you, then you should also be able to save the file as an xlsx file which will strip the VBA instead of running DeleteAllVBA function.

 

[Biz]

Hi JS411,

I am using Excel 2003 so I will use the same code.
Your suggestion is perfect for Excel 2007/2010.

Thanks for your input.

Biz

 

[Jerry Sullivan]

Hi Mate,

One more thought on this...
I couldn't tell from your post whether you had multiple sheet or one sheet per template.

If you have multiple sheets and if they have cell references links between each other, then those links will still be pointing at the source workbook when you use Copy (Array of Sheets) to (New Workbook).

If that is the case, you could try adding code to Find-Replace the filename of the Source Workbook [MyWorkbook] with a null string "". This will add a Find-Replace step however it might still be quicker than the process you currently have.

Please let me know whether you find an improvement.

 

[Biz]

Hi Mate,

I have multiple sheets in workbook. Since this master template I am generating it for every business unit (BU) and yes there are 170 BU.

Biz

 

[Jerry Sullivan]

Do they have references between the sheets?
If so, do you want try the find and replace approach?

 

[Biz]

Worksheet tab 2006-07 has links to external file.
All other worksheets tabs inputs except F08 Budget links some of tabs.

Biz

 

[Jerry Sullivan]

Worksheet tab 2006-07 has links to external file.
All other worksheets tabs inputs except F08 Budget links some of tabs.

Biz

The issue isn't with links to other workbooks. The issue is links that currently reference your Template's filename.

If your Template file is named MyTemplateFile.xls,
using this code will result in copying these sheets to a new book.

Sheets(Array("MySheet1", "MySheet2", "MySheet3")).Copy

If those were the only sheets you need for each BU, then you might be all set.
However, you'll need to check to make sure that you don't have some formulas or references that still point back to your template file.
Like
In MySheet1 Cell A1: =[MyTemplateFile.xls]!MySheet2!A1+[MyTemplateFile.xls]!MySheet3!A1

That shouldn't happen for ordinary formulas, however it might happen for references like PivotTable datasources.