Home > other >  Check if a filename already exist before creating a new excel file
Check if a filename already exist before creating a new excel file

Time:03-18

With the help of others, I was able to build this working code. I do however need help in adding conditions to it.

Before the worksheets are moved to a new file it must first check if a file of the same name already exist. If one does exist, then it should just update it (paste new data at the bottom). If none exist, then it should create one (which is what this code is doing)

Sub ExportSheets()
' Export segregated sheets to individual workbooks

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sPath As String, sAddress As String, wsCur As Worksheet
Dim arrNoMoveSh, mtchSh
Dim sht As String
Dim x As Range
Dim rng As Range
Dim last As Long
Dim ControllerTab As Worksheet
Dim ControllerTabBase As Range

    Set ControllerTab = ThisWorkbook.Worksheets("Controller")
    Set ControllerTabBase = ControllerTab.Range("B1")

 ' --Creates an array of the sheet names to not be moved
 arrNoMoveSh = Split("Read Me,Validations,Controller,MTI Data,Other", ",")

 ' --Store path of this workbook
 sPath = ThisWorkbook.path & Application.PathSeparator

 ' --Loop through worksheets
 For Each wsCur In ThisWorkbook.Worksheets
      mtchSh = Application.Match(wsCur.Name, arrNoMoveSh, 0)
      If IsError(mtchSh) Then 'no sheet names found in the array
          wsCur.Copy 'create a new workbook for the sheet to be copied!!!

' --Specifies the sheet name in which the data is stored
sht = wsCur.Name

last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:P" & last)

Sheets(sht).Range("N1:N" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True

For Each x In Range([BB2], Cells(Rows.Count, "BB").End(xlUp))
    With rng
    .AutoFilter Field:=14, Criteria1:=x.Value
    .SpecialCells(xlCellTypeVisible).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    ActiveSheet.Paste
    End With

Next x

    Sheets(sht).Activate
    Sheets(sht).Delete

        ActiveWorkbook.SaveAs sPath & wsCur.Name & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=True

     End If

Next wsCur

Application.ScreenUpdating = True
Application.DisplayAlerts = True

ControllerTab.Activate
ControllerTabBase.Select

End Sub


CodePudding user response:

Here's a function to determine whether a file currently exists:

Private Function FileExists(FileName As String) As Boolean
    On Error Resume Next
    FileExists = CBool(FileLen(FileName)   1)
End Function

CodePudding user response:

Function FileExists(FileName As String) As Boolean
    FileExists = Len(Dir(FileName)) > 0
End Function

Usage

I would add the FileExists(FileName) clase to the existing If statement.

    FileName = sPath & wsCur.Name & ".xlsx"
    If IsError(mtchSh) And Not FileExists(FileName) Then 'no sheet names found in the array
  • Related