Closing ActiveWorkbook but not ThisWorkbook

MistakesWereMade

Board Regular
Joined
May 22, 2019
Messages
103
My program opens a spreadsheet. I want to close this one using the x symbol without asking me if I'd like to close all other spreadsheets.

I have this written in my ThisWorkbook coding section.

Code:
Public swb As String


Private Sub Workbook_Open()


    Application.ScreenUpdating = False
    swb = ThisWorkbook.Name
    ThisWorkbook.Application.Visible = False
    Application.ScreenUpdating = True
    
    SplashUserForm.Show


End Sub


Private Sub WbkClose()
 
If swb <> ActiveWorkbook.Name Then
    ActiveWorkbook.Close = True
    ThisWorkbook.Close = False
End If


End Sub

I want the workbook associated with swb to remain open and not asked to be canceled. I have a separate button in my userform that is used to close this workbook.
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
This code here is in my worksheet in my main workbook. I use it to just auto-update a column in my worksheet from a folder.

Code:
Private Sub CommandButton1_Click()


  Dim strTargetFolder As String, strFileName As String, nCountItem As Integer
  Dim RngBeg  As Range
  Dim RngEnd  As Range
  
  ' Clear any previous file names in column "D"
  Set RngBeg = Range("D2")
  Set RngEnd = Cells(Rows.Count, "D").End(xlUp)
  If RngEnd.Row < RngBeg.Row Then Exit Sub Else Range(RngBeg, RngEnd).ClearContents


  '  Initialization
  nCountItem = 2
  strTargetFolder = "C:\Users\My USER\Desktop\My Files" & "\"
  strFileName = Dir(strTargetFolder, vbDirectory)


  '  Get the file name
  Do While strFileName <> ""
    If strFileName <> "." And strFileName <> ".." Then
      Cells(nCountItem, 4) = strFileName
      nCountItem = nCountItem + 1
    End If
    strFileName = Dir
  Loop
  
End Sub

This here is my ThisWorkbook code.

Code:
Public swb As String


Private Sub Workbook_Open()


    Application.ScreenUpdating = False
    swb = ThisWorkbook.Name
    ThisWorkbook.Application.Visible = False
    Application.ScreenUpdating = True
    
    SplashUserForm.Show


End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)


If swb <> ActiveWorkbook.Name Then
    ActiveWorkbook.Close savechanges:=False
    Application.Visible = False
    Unload UserForm1
    UserForm1.Show vbModeless
Else
Exit Sub
End If


End Sub

This here is just a userform that I use as a cover form at the start up of my program.

Code:
Private Sub UserForm_Initialize()


HideTitleBar Me
With Me
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With


End Sub


Private Sub UserForm_Activate()


    Application.Wait (Now + TimeValue("00:00:02"))
    SplashUserForm.Label1.Caption = "Creating Forms..."
    SplashUserForm.Repaint
    Application.Wait (Now + TimeValue("00:00:01"))
    SplashUserForm.Label1.Caption = "Opening..."
    SplashUserForm.Repaint
    Application.Wait (Now + TimeValue("00:00:01"))
    Unload SplashUserForm
    
    UserForm3.Show vbModeless
    
End Sub

This code here is for a user form that acts as an index to my program features. Only one feature is functional, it being userform1.

Code:
Private Sub CommandButton1_Click()


UserForm1.Show vbModeless


End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        ThisWorkbook.Application.Visible = True
        DisplayAlerts = False
        Application.Quit
    End If
End Sub

This user form code is my program's search engine. I use it to search for a specific file in a folder and to open it.

Code:
Dim ListCB As Variant
Public OpeningVar As String


Private Sub UserForm_Initialize()


  Dim TmpText As String
  If Not IsArray(Sheets("Data").Range("Data!I2:I600")) Then
    temptext = Worksheets("Data").Range("E2").Value
    Worksheets("Data").Range("E2").Value = ""
  End If
  ListCB = Sheets("Data").Range("Data!I2:I600")
  If Len(temptext) Then Worksheets("Data").Range("E2").Value = temptext
  GetCBList
  
End Sub


Sub GetCBList()


  Dim b As Variant, i As Long
  Dim a() As Variant: ReDim a(UBound(ListCB))
  For Each b In ListCB
    If Len(b) Then
      If InStr(1, b, ComboBox1.Value, vbTextCompare) > 0 Or ComboBox1.Value = "" Then: a(i) = b: i = i + 1
    End If
  Next
  If i > 0 Then ReDim Preserve a(i - 1)
  ComboBox1.List = a
  
End Sub


Private Sub ComboBox1_Change()


  GetCBList
  ComboBox1.DropDown
  On Error Resume Next
  Worksheets("Data").Range("E2").Value = ComboBox1.Value
  
End Sub


Private Sub CommandButton1_Click()
    
    Dim Wbk As Workbook
    Dim Pth As String
    Dim myRange As Range
    
    Set myRange = ThisWorkbook.Worksheets("Data").Range("E2")
    
    Pth = Environ("Userprofile") & "\Desktop\My Files\"


    OpeningVar = Me.ComboBox1.Value


    Me.ComboBox1.Clear


    On Error Resume Next
    
    Set Wbk = Workbooks.Open(Pth & OpeningVar)
   
    myRange.Clear
   
    On Error GoTo 0
   
    If Wbk Is Nothing Then
        MsgBox "Workbook not found."
    End If
    
    myRange.Clear
    
End Sub


Private Sub CommandButton3_Click()


Application.Visible = True


End Sub


Well that's all my code... Very lengthy, but if it can help resolve the issue, I'd be so pleased. Thanks for helping Fluff.
 
Last edited:
Upvote 0
The only place where I can see you trying to close a workbook is here
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)


If swb <> ActiveWorkbook.Name Then
    ActiveWorkbook.Close savechanges:=False
    Application.Visible = False
    Unload UserForm1
    UserForm1.Show vbModeless
Else
Exit Sub
End If
This will only trigger when you close "ThisWorkbook"
Where are you trying to close the recently opened book?
 
Upvote 0
Doesn't it trigger when I try to close a workbook that isn't ThisWorkbook? Right now, when I close the recently opened file, it will not save and then close. Then I can go back into the userform1 and search/open a new file. It is when I try to close the newly opened file again, that it doesn't run like the first time around.

I try to close the recently opened book using the normal red x in the right hand corner.
 
Last edited:
Upvote 0
Here is something interesting... I realized that if I adjust my code to be like below...

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)


If swb <> ActiveWorkbook.Name Then
    ActiveWorkbook.Close savechanges:=False
    UserForm1.Show vbModeless
Else
Exit Sub
End If


End Sub

It will close the newly opened worksheet no matter how many times I search... Which is what I want. It appears that my application has to be visible for it to work. I am not at all sure why this has to be the case as I would like for it to not reappear when I close out of the newly open book. Maybe this is a clue as to what is tripping up?
 
Upvote 0
I try to close the recently opened book using the normal red x in the right hand corner.
If you only have 1 visible workbook open this will close the entire application, including ThisWorkbook.
You would do better to close the recently opened via code like
Code:
Dim wbk As Workbook
Private Sub CommandButton1_Click()
   
   Set wbk = Workbooks.Open("C:\mrexcel\+book1.xlsm")
End Sub

Private Sub CommandButton2_Click()
wbk.Close False
ThisWorkbook.Application.Visible = False
End Sub
 
Upvote 0
Where should I put that? I would like to just use the red x since I cannot put a button on each new book to close itself by code. There are hundreds of new books that this program is opening.

The code does work at least once... So there really isn't a way to make it keep working? I could send my program if you wouldn't mind taking a closer look.
 
Upvote 0
Could I do a condition inside of a loop that checks the active workbook each time an excel window is closed? That way if the workbook is not my program workbook, I could just tell it to close that single workbook without saving and cancel closing the entire application?
 
Upvote 0
You don't put the button on the worksheet, you put it on the userform that opens the other books.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top