Closing form doesn't stop program

I have a form that opens a file and then makes some changes and saves it. The form has an exit button which unloads the form. However, this doesn't seem to release the newly saved file. When I exit the form via the upper right exit button X, it does. Is there another command I need to use in addition to unload form to get the program to completely release the file?

Hi there,

I suspect that the problem lies in the method which you are using for closing the UserForm.

Insert the following code in a standard VBA CodeModule:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub ShowForm()

    Dim frm As F01_TestForm

    Set frm = New F01_TestForm

        frm.Show

        Unload frm

    Set frm = Nothing

End Sub

and use the following code in the CodeModule associated with the UserForm itself:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode <> vbFormCode Then

        Call btnExit_Click
        Cancel = True

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub btnExit_Click()
    Me.Hide
End Sub

In general, UserForms should be instantiated, displayed (.Show) and unloaded from a calling routine located in a CodeModule which is separate from the CodeModule of the UserForm.

The UserForm should be hidden (not unloaded) by one or more routines located in the CodeModule associated with the UserForm.


Hope this helps - please let me know how you get on.

Regards,

Greg M

Originally Posted by Greg M

Hi there,

I suspect that the problem lies in the method which you are using for closing the UserForm.

Insert the following code in a standard VBA CodeModule:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub ShowForm()

    Dim frm As F01_TestForm

    Set frm = New F01_TestForm

        frm.Show

        Unload frm

    Set frm = Nothing

End Sub

and use the following code in the CodeModule associated with the UserForm itself:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode <> vbFormCode Then

        Call btnExit_Click
        Cancel = True

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub btnExit_Click()
    Me.Hide
End Sub

In general, UserForms should be instantiated, displayed (.Show) and unloaded from a calling routine located in a CodeModule which is separate from the CodeModule of the UserForm.

The UserForm should be hidden (not unloaded) by one or more routines located in the CodeModule associated with the UserForm.


Hope this helps - please let me know how you get on.

Regards,

Greg M

Thanks Greg. This was helpful. One follow up question if you don't mind. I open a .csv file initially using the first segment of code to see what it contains so I know its dimensions and fields and populate a combobox and then close it. I then open it for editing using the second method and after the changes are made the file is saved, but I intentionally haven't exited the form yet at this point. However, the file that I edited and saved cannot be closed at this point while the form is still running. Why is that? I have included my entire program below for reference.

Option Explicit
Dim stHeadings As Variant           'Array storing each column heading of the file
Dim stFileName As Variant           'File path and name of .csv file to be processed
Dim nRow As Integer                 'Number of rows in .csv file
Private Sub OpenFile_Click()
        
    Const FOR_READING = 1           'Constant designating file object stream for reading
    Const FOR_WRITING = 2           'Constant designating file object stream for writing
    Const MAX = 1048576             'Constant designating maximum number of rows for Excel
    Dim stLineOfText(MAX) As String 'Array storing each line of text read from .csv file
    Dim nCol As Integer             'Number of columns in .csv file
    Dim objFSO                      'File system object
    Dim objFile                     'Stores reference to file path and name
    Dim objStream                   'Opens the specified file and returns a TextStream for reading

    
    'Open .csv file for reading;Exit if canceled by user
    stFileName = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If stFileName = False Then
        Exit Sub
    End If

    'Create file system object for processing file
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(stFileName)
    Set objStream = objFile.OpenAsTextStream(FOR_READING)

    'Read in and store each line of file into an array
    nRow = 0
    Do Until objStream.AtEndOfStream
        stLineOfText(nRow) = Trim(objStream.ReadLine)
        nRow = nRow + 1
    Loop

    'Free up resources
    objStream.Close
    Set objStream = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

    'Parse string, removing commas, and storing each heading
    'Remove extra quotations and populate Combobox with headings
    stHeadings = Split(stLineOfText(0), ",")
    For nCol = 0 To UBound(stHeadings)
        ComboBox1.AddItem Replace(stHeadings(nCol), """", "")
    Next

End Sub
Private Sub Process_Click()
    
    Dim stFileDate As Variant   'Date portion of file name
    Dim nCol As Integer         'Loop counter tracking first range of columns for <40 filter
    Dim nCol2 As Integer        'Loop counter tracking second range of columns for >=40 filter
    Dim stTabName As String     'Tab name of pivot source
    Dim i As Integer            'Loop variable for traversing stStoreName()
    Dim stLastCol As String     'End range values for <40/>=40 filter
    Dim stFirstCol As String    'Beginning range value for >=40 filter
    
    'Check to make sure ComboBox has a value
    If ComboBox1.ListIndex = -1 Then
        MsgBox ("Please select a value")
        Exit Sub
    End If
    
    'Open file in Excel
    Workbooks.Open Filename:=stFileName
    
    'Format cells accordingly
    Columns.AutoFit
    For nCol = 1 To UBound(stHeadings) + 1
        If Cells(1, nCol).Value = ComboBox1.Value Then
            ActiveSheet.Columns(nCol).NumberFormat = "General"
        ElseIf Cells(1, nCol).Value = "Date" Then
            ActiveSheet.Columns(nCol).NumberFormat = "m/d/yyyy h:mm:ss AM/PM;@"
        ElseIf Cells(1, nCol).Value = "Time" Then
            ActiveSheet.Columns(nCol).NumberFormat = "[h]:mm:ss.000;@"
        Else
            ActiveSheet.Columns(nCol).NumberFormat = "@"
        End If
    Next
    
    'Add Payable column, format to general and add formula
    Columns("D:D").Select
    selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Payable"
    Columns("D:D").Select
    selection.NumberFormat = "General"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=OR(RC[7]=""Activation"",LEN(RC[10]&RC[11])>0)"
    Range("D2").Select
    selection.AutoFill Destination:=Range("D2:D" & nRow)
    
    'Create pivot table
    'Get source tab name for pivot table
    stTabName = FileNameFromPath(CStr(stFileName))
    stTabName = Mid(stTabName, 1, Len(stTabName) - 5)
    
    'Select all cells with data
    ActiveSheet.UsedRange.Copy

    'Create pivot table
    Sheets.Add
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        stTabName & "!R1C1:R231C22", Version:= _
        xlPivotTableVersion15).CreatePivotTable TableDestination:="Sheet1!R3C1", _
        TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("StoreName")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Payable")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Retail")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("DeviceUser")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("ID"), "Sum of ID", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of ID")
        .Caption = "Count of ID"
        .Function = xlCount
    End With
    
    'Price grouping
    nCol = 2
    Do While Cells(5, nCol).Value < 40 And Cells(5, nCol).Value <> "Grand Total"
        nCol = nCol + 1
    Loop

    stLastCol = Number2Letter(nCol - 1)
    Range("B5:" & stLastCol & "5").Select
    selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Retail2").PivotItems("Group1").Caption = "Under $40"
    
    nCol2 = nCol
    Do While Cells(5, nCol2).Value >= 40 And Cells(5, nCol2).Value <> "Grand Total"
        nCol2 = nCol2 + 1
    Loop
    
    stFirstCol = Number2Letter(CLng(nCol))
    stLastCol = Number2Letter(nCol2 - 1)
    Range(stFirstCol & "5" & ":" & stLastCol & "5").Select
    selection.Group
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Retail2").PivotItems("Group2").Caption = "$40+"
    
    'Store filter
    Range("B1").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("StoreName").CurrentPage = "(All)"
          
    With ActiveCell.PivotTable.PivotFields("StoreName")
        For i = 1 To .PivotItems.count
            If Not .PivotItems(i).Name Like "TSBTF*" Then
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
        
    ActiveSheet.PivotTables("PivotTable1").PivotFields("StoreName").EnableMultiplePageItems = True
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Payable").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Payable").CurrentPage = "TRUE"
    
    'Create directories as needed and save file as TracFone Commission.xlsx
    stFileDate = FileNameFromPath(CStr(stFileName))
    stFileDate = Split(stFileDate, "_")
    stFileDate = Split(stFileDate(1), ".")
    CreateDirectorySaveFile (stFileDate(0))
    
End Sub
Sub CreateDirectorySaveFile(stFileDate As String)
    
    Dim stYear As String        'Year designation for file path
    Dim stMonth As String       'Month designation for file path
    Dim stDay As String         'Day designation for file path
    Dim Ans As Integer          'User response (Y/N) to file overwrite
    Dim stFileName As String    'Filename and path of .xlsx

    'Parse filename and separate YYYY, MM, DD and append "-" where needed
    stYear = Mid(stFileDate, 1, 4)
    stMonth = Mid(stFileDate, 5, 2)
    stMonth = "-" & stMonth
    stDay = Mid(stFileDate, 7, 2)
    stDay = "-" & stDay
    
    'Create directory J:\Reports\WeeklySafeLink\YYYY if needed
    If Len(Dir("J:\Reports\WeeklySafeLink\" & stYear, vbDirectory)) = 0 Then
       MkDir "J:\Reports\WeeklySafeLink\" & stYear
    End If
    
    'Create directory J:\Reports\WeeklySafeLink\YYYY\YYYY-MM if needed
    If Len(Dir("J:\Reports\WeeklySafeLink\" & stYear & "\" & stYear & stMonth, vbDirectory)) = 0 Then
       MkDir "J:\Reports\WeeklySafeLink\" & stYear & "\" & stYear & stMonth
    End If
    
    'Create directory J:\Reports\WeeklySafeLink\YYYY\YYYY-MM\YYYY-MM-DD if needed
    If Len(Dir("J:\Reports\WeeklySafeLink\" & stYear & "\" & stYear & stMonth & "\" & stYear & stMonth & stDay, vbDirectory)) = 0 Then
       MkDir "J:\Reports\WeeklySafeLink\" & stYear & "\" & stYear & stMonth & "\" & stYear & stMonth & stDay
    End If
    
    'Save file as J:\Reports\WeeklySafeLink\YYYY\YYYY-MM\YYYY-MM-DD\TracFone Commission.xlsx
    'Check if file already exists, and if so, give option to overwrite or cancel
    stFileName = "J:\Reports\WeeklySafeLink\" & stYear & "\" & stYear & stMonth & "\" & stYear & stMonth & stDay & "\" & "TracFone Commission.xlsx"
    If Len(Dir(stFileName)) = 0 Then
       ActiveWorkbook.SaveAs stFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Else
        Ans = MsgBox("File already exists!" & vbCrLf & vbCrLf & "Do you want to replace it?", vbYesNo + vbInformation)
        If (Ans = vbYes) Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs stFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            Application.DisplayAlerts = True
        Else
            Exit Sub
        End If
    End If

End Sub
Private Sub Cancel_Click()
    Unload TracFone
End Sub
Function FileNameFromPath(stFullPath As String) As String
    FileNameFromPath = Right(stFullPath, Len(stFullPath) - InStrRev(stFullPath, "\"))
End Function
Function Number2Letter(nColumnNumber As Long) As String
    'PURPOSE: Convert a given number into it's corresponding Letter Reference
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
       
    'Convert To Column Letter
    Number2Letter = Split(Cells(1, nColumnNumber).Address, "$")(1)
      
End Function
Function Letter2Number(stColumnLetter As String) As Long
    'PURPOSE: Convert a given letter into it's corresponding Numeric Reference
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
         
    'Convert To Column Number
    Letter2Number = Range(stColumnLetter & 1).Column
        
End Function

Hi again,

Many thanks for your feedback and also for the Reputation increase - much appreciated!

Ah ok, if I had read your original post more closely I might have understood the problem better - sorry about that.

By default, a UserForm is Modal, which means that cells, worksheets, workbooks etc. are "untouchable" for as long as that UserForm is displayed. If you want to be able to access other items (e.g. to close the edited workbook) while a UserForm remains displayed, you must open it as a Modeless UserForm, i.e. instead of "TracFone.Show" you should use "TracFone.Show vbModeless".


Hope this helps - as before, please let me know how you get on.

Best regards,

Greg M

Originally Posted by Greg M

Hi again,

Many thanks for your feedback and also for the Reputation increase - much appreciated!

Ah ok, if I had read your original post more closely I might have understood the problem better - sorry about that.

By default, a UserForm is Modal, which means that cells, worksheets, workbooks etc. are "untouchable" for as long as that UserForm is displayed. If you want to be able to access other items (e.g. to close the edited workbook) while a UserForm remains displayed, you must open it as a Modeless UserForm, i.e. instead of "TracFone.Show" you should use "TracFone.Show vbModeless".


Hope this helps - as before, please let me know how you get on.

Best regards,

Greg M

Thanks Greg! Both of your posts were very informative and useful to me. I tried to give you more credit for the additional response, but the system wouldn't let me.

Originally Posted by bvwalker1

Thanks Greg! Both of your posts were very informative and useful to me. I tried to give you more credit for the additional response, but the system wouldn't let me.

Where is TracFone.Show located? I do not call this explicitly anywhere so is it being called behind the scenes somewhere? It's my main form.
Thanks, Greg!