Re-execute if the workbook exists or not using vba Excel

Question

I want to execute, if the workbook exists already then re- run it if not exists then create a workbook.

I have uniques values(x) and array(names). I need to compare them if both are equal if not it has to create a workbook with name of array(names) that not had in uniques values(x)

My code:

Sub mac()

Dim c as integer
Dim x as range
Dim s_AgingSCM as string
Dim Array_SCM_Aging as variant
Dim NewBook as workbook
Dim NewBook_SCM as workbook
Dim Master_workbook as workbook
Dim rngCopy_Aging as range
Dim rngFilter_Ws2 as range

For c = LBound(Array_SCM_Aging) To UBound(Array_SCM_Aging)
            Set Master_workbook = ThisWorkbook
            s_AgingSCM = Array_SCM_Aging(c, 1)
            Set x = Master_workbook.Sheets("BASS").Range("AY" & c)
                    If x = s_AgingSCM Then                                                      

                         With rngFilter_Ws2

                                .AutoFilter field:=32, Criteria1:="<>(a)  0 - 360", Operator:=xlFilterValues
                                .AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues

                         Set rngCopy_Aging = .SpecialCells(xlCellTypeVisible)
                                             .AutoFilter ' Switch off AutoFilter
                         End With

                         rngCopy_Aging.Copy NewBook.Worksheets("Aging Inventory").Cells(1, 1)
                         Application.DisplayAlerts = False           
                   Else

                   Dim fso: Set fso = createObject("Scripting.FileSystemObject")
                    Dim folder: Set folder = fso.GetFolder("C:\")
                    Dim file, fileNames                    
                    Dim rngCopy_SCMAging As Range                   

                    For Each file In folder.Files
                            If Right(file.Name, 4) = "xlsx" Then
                            fileNames = fileNames & file.Name & ";"         ' will give a list of all filenames
                            End If
                    Next

                    If InStr(fileNames, s_AgingSCM) = 0 Then                     

                            With NewBook_SCM                            

                                Set NewBook_SCM = Workbooks.Add
                            .Title = s_AgingSCM
                          NewBook_SCM.Worksheets("sheet1").Name = "Aging Inventory"
                            With rngFilter_Ws2

                                .AutoFilter field:=32, Criteria1:="<>(a)  0 - 360", Operator:=xlFilterValues
                                .AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues

                                Set rngCopy_SCMAging = .SpecialCells(xlCellTypeVisible)
                                                       .AutoFilter ' Switch off AutoFilter
                            End With

                                rngCopy_SCMAging.Copy Destination:=NewBook_SCM.Worksheets("Aging Inventory").Cells(1, 1)                            

                          .SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"
                          Application.DisplayAlerts = False
                          NewBook_SCM.Close                           
                        End With
'                      Else
                    End If

End sub

I was stuck here since 2 days. All i want is if the workbook exists then overwrite with the new workbook or else if its not exists create a new workbook.

Can someone please help me out.

Here you can find info on how to check if file/workbook exists: http://stackoverflow.com/questions/16351249/vba-check-if-file-exists — Dawid SA Tokyo, May 25 '16 at 10:34

score 0 · Answer 1 · answered May 25 '16 at 10:48

0

A quick way to do it would be placing: -

If fso.FileExists(Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx")
    fso.DeleteFile Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx", True
End If

Above the line

.SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"

But this would not account for if the file could not be deleted (i.e. already open)

answered May 25 '16 at 10:48

Gary Evans

1,850
4
15
30

Im sorry its not working. Is there any other way to do it. Please let me know. – buddha sreekanth May 25 '16 at 11:52
What specifically isn't working? the only other thing to suggest with such little information is changing `.SaveAs` to `.SaveAs Filename:=Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"` – Gary Evans May 25 '16 at 12:22
I haven't seen any changes in my result even after your code has been added. It give the same result as before. I have already a workbook with the `NewBook_SCM` when i inserted your code before the `.saveas` it did not done anything. I have to re-execute the `NewBook_SCM`. – buddha sreekanth May 25 '16 at 12:34
Im not too eager to pursue this as I'm not getting enough detail to help. Specifically, in your code, what one line is failing and what is the full error message. – Gary Evans May 25 '16 at 12:38

Re-execute if the workbook exists or not using vba Excel

1 Answers1