0

I have a vba code (not mine copied from another site) which seperates data from master file into multiple files based on specific column ,now after the data has been separated into multiple files the code execution has been completed , but the master file is open at the end which is not good , tried to various ways to apply code for save the master file and close the master file but not working , I have no idea about vba coding,the master file is FE_JUL.xlsx

Sub ExportDatabaseToSeparateFiles()
     'Export is based on the value in the KeyCol
    Dim myWb As Workbook
    Dim myCell As Range
    Dim mySht As Worksheet
    Dim myName As String
    Dim myArea As Range
    Dim myShtName As String
    Dim KeyCol As String
    Dim myField As Integer

    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\FInal Estimate\Excel\2019\temp\FE_JUL.xlsx"
    Set myWb = Application.Workbooks("FE_JUL.xlsx")
    myWb.Activate
    myShtName = ActiveSheet.Name
    KeyCol = "A"
    Set myArea = Intersect(ActiveSheet.UsedRange, Range(KeyCol & "1").EntireColumn).Cells
    Set myArea = myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1, 1)
    myField = myArea.Column - myArea.CurrentRegion.Cells(1).Column + 1
    For Each myCell In myArea
        On Error GoTo NoSheet
        myName = Worksheets(myCell.Value).Name
        GoTo SheetExists:

NoSheet:
        Set mySht = Worksheets.Add(Before:=Worksheets(1))
        mySht.Name = myCell.Value
        With myCell.CurrentRegion
            .AutoFilter Field:=myField, Criteria1:=myCell.Value
            .SpecialCells(xlCellTypeVisible).Copy _
                    mySht.Range("A1")
            mySht.Cells.EntireColumn.AutoFit
            .AutoFilter
        End With
        Resume

SheetExists:
    Next myCell
    For Each mySht In ActiveWorkbook.Worksheets
        If mySht.Name = myShtName Then
            Exit Sub
        Else
            mySht.Move
            ActiveWorkbook.SaveAs "C:\FInal Estimate\Excel\2019\temp\temp\" & ActiveSheet.Name & ".xlsx"
            ActiveWorkbook.Close
        End If
    Next mySht

    myWb.Save
    myWb.Close

End Sub
Ajay
  • 77
  • 1
  • 10
  • 1
    You are closing first `ActiveWorkbook` (because when you open a workbook it becomes the focus and so the ActiveWorkbook) which in this case is the same `myWb` so no, you are not closing anywhere in your code the master workbook. You should try to avoid using `.Activate` because it leads to problems like this. Also you are using too much `GoTo` when it can be handled easier and less confusing. Set a variable for your master workbook and close the masterworkbook using the variable. – Damian Sep 13 '19 at 11:22
  • Thanks Damien for the comment , can you help me with the code you are explaining ? – Ajay Sep 13 '19 at 11:30
  • Well now your code closes the master file... if it's "FE_JUL" and not september like before. – Damian Sep 13 '19 at 11:32
  • Sorry, Just got onfused due to multiple files – Ajay Sep 13 '19 at 11:33
  • I think you mean to close the workbook running the code after the execution is done? – Damian Sep 13 '19 at 11:34
  • No not the code running workbook, after the code execution is completed the master file "FE_JUL.xlsx" is open I have to close this file – Ajay Sep 13 '19 at 11:36

1 Answers1

1

The main reason why your code does not work is because there is an Exit Sub which exits the sub so myWb.Close is never reached. You must replace it with Exit For.

Nevertheless I recommend to refine the code as follows to make it more solide and reliable. You might benefit from reading How to avoid using Select in Excel VBA. Also using Goto is a bad practice see below for a solution without it.

Option Explicit

Sub ExportDatabaseToSeparateFiles()
    'Export is based on the value in the KeyCol
    Application.ScreenUpdating = False

    Dim myWb As Workbook
    Set myWb = Workbooks.Open(Filename:="C:\FInal Estimate\Excel\2019\temp\FE_JUL.xlsx")

    Dim MySht As Worksheet
    Set MySht = myWb.ActiveSheet

    Const KeyCol As String = "A"

    Dim myArea As Range
    Set myArea = Intersect(MySht.UsedRange, MySht.Range(KeyCol & "1").EntireColumn).Cells
    Set myArea = myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1, 1)

    Dim myField As Long
    myField = myArea.Column - myArea.CurrentRegion.Cells(1).Column + 1

    Dim myCell As Range
    For Each myCell In myArea
        If Not WorksheetExists(myCell.Value, myWb) Then
            Dim AddedSht As Worksheet
            Set AddedSht = myWb.Worksheets.Add(Before:=myWb.Worksheets(1))
            AddedSht.Name = myCell.Value
            With myCell.CurrentRegion
                .AutoFilter Field:=myField, Criteria1:=myCell.Value
                .SpecialCells(xlCellTypeVisible).Copy AddedSht.Range("A1")
                AddedSht.Cells.EntireColumn.AutoFit
                .AutoFilter
            End With
        End If
    Next myCell

    Dim ws As Worksheet
    For Each ws In myWb.Worksheets
        If ws.Name = MySht.Name Then
            Exit For
        Else
            ws.Move
            ActiveWorkbook.SaveAs "C:\FInal Estimate\Excel\2019\temp\temp\" & ActiveSheet.Name & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False
        End If
    Next ws

    Application.ScreenUpdating = True

    myWb.Save
    myWb.Close SaveChanges:=False
End Sub


Public Function WorksheetExists(WorksheetName As String, Optional InWorkbook As Workbook) As Boolean
    If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = InWorkbook.Worksheets(WorksheetName)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Hi,I copy paste the same code as it is and executed it, received an error as " Object variable or with block variable not set" – Ajay Sep 13 '19 at 11:46
  • @Ajay in which line? – Pᴇʜ Sep 13 '19 at 11:47
  • when I click on Debug, it show the Line 16 in Yellow colour for the Runtime error "91" "Object variable or with block variable not set" – Ajay Sep 13 '19 at 11:53
  • @Ajay Line 16 doesn't help because I have no idea what you counted. Please tell the code which throws the error. – Pᴇʜ Sep 13 '19 at 11:54
  • Set myArea = Intersect(MySht.UsedRange, MySht.Cells(1, KeyCol).EntireColumn).Cells.Offset(1, 0).Resize(myArea.Rows.Count - 1, 1) – Ajay Sep 13 '19 at 12:02
  • 1
    Tried the edit and it worked, thanks for the help Guys :) :) :) – Ajay Sep 13 '19 at 12:11
  • I having some issues while using your above code, at line "AddedSht.Name = myCell.Value" , here it says Method 'Name' of Object '_Worksheet' failed , the issue here is it works for some files and fails for some files any idea why ? – Ajay Sep 19 '19 at 04:37
  • @Ajay Can you tell which value is `myCell.Value` in case of error? Make sure it is not empty and not longer than 31 characters and it contains non of these characters `*."/\[]:;|=,\``. This is a restriction of Excel. – Pᴇʜ Sep 19 '19 at 05:51
  • the value of 'myCell.Value' is Empty, any idea why is it taking empty ? why does it find empty ? There are correct sheet created for the data, only this extra sheet gives empty value gives error – Ajay Sep 19 '19 at 12:31
  • That is something you must find out yourself. Debug your code using F8 and check the values of your variables: [Excel Easy - Debugging](https://www.excel-easy.com/vba/examples/debugging.html) – Pᴇʜ Sep 19 '19 at 12:34