• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

To create Workbook if not existing.

ajaar

Member
Dear Friends,

I have below code to create new workbooks with name in the list. when I run the code, it ask every time " file name already exist, do you want to replace". I wanted to create the workbook only if the file is not existing in the location without pop up any message. I tried to include 'on error resume next'. still not functioning in the way I want. any help please.

Code:
Sub createwb()
Const sPath = "C:\Company\"
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook
 Application.ScreenUpdating = False
 'Application.DisplayAlerts = False
  Range("G4", Range("G" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [T4], True
 ar = Range("T5", Range("T" & Rows.Count).End(xlUp))
'Loop through all unique instances of the Results from the Advanced Filter.
  For i = LBound(ar) To UBound(ar)
  On Error Resume Next
  Workbooks.Add
  ActiveWorkbook.SaveAs (sPath & ar(i, 1) & ".xlsx")
  On Error GoTo 0
 
  ActiveWorkbook.Close  'Close and Save
  Next i
  Application.CutCopyMode = 0
 '[F1].AutoFilterMode = False
 ActiveSheet.AutoFilterMode = False
 Application.ScreenUpdating = True
 'Application.DisplayAlerts = True
End Sub

Regards
Ajaar
 
Check

Code:
Option Explicit

Sub createwb2()
Const sPath = "C:\Company\"
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook
 Application.ScreenUpdating = False
 'Application.DisplayAlerts = False
 Range("G4", Range("G" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [T4], True
 ar = Range("T5", Range("T" & Rows.Count).End(xlUp))
'Loop through all unique instances of the Results from the Advanced Filter.
 For i = LBound(ar) To UBound(ar)
    If Not Len(Dir(sPath & ar(i, 1) & ".xlsx")) <> 0 Then
     Workbooks.Add
     ActiveWorkbook.SaveAs (sPath & ar(i, 1) & ".xlsx")
      ActiveWorkbook.Close  'Close and Save
     
    End If
 Next i
  Application.CutCopyMode = 0
 '[F1].AutoFilterMode = False
ActiveSheet.AutoFilterMode = False
 Application.ScreenUpdating = True
 'Application.DisplayAlerts = True
End Sub
 
Back
Top