Executing several actions within Before_Close

Question

I have a few processes that are executing in my Workbook - within Workbook_BeforeClose sub The problem is that the 1st action - "Checking on empty cells:" is not working properly with the other 2 actions - "CreatingRawData Macro:" and "Exporting Data:"

If there are empty cells in my Workbook and when I close out of Worksheet - instead of stop working, and populate error messages about an empty cells - it proceeds to the next action - and records macro and then exports it. It works perfectly well - only when I remove "CreatingRawData" and "Exporting Data" But I must have these in my vba...

What should I do to stop executing further if there empty cells in my Workbook? (I have Cancel = True within "Checking on empty cells", still not stopping)

Here is the full code, I have withing "ThisWorkbook":

      Private Sub Workbook_BeforeClose(Cancel As Boolean)

     '
     ' Checking on empty cells:
     '

      Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

      Set sh = ActiveSheet 'use here your sheet
      lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
      lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
   
      On Error GoTo NoBlanks
      Set emptyCells = sh.Range(sh.Cells(5, 1), sh.Cells(lastRow, 
                                             lastCol)).SpecialCells(xlCellTypeBlanks)

      If Not emptyCells Is Nothing Then
      MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
      sh.Activate: emptyCells.Select
      
      Cancel = True

      Else

      NoBlanks:
           Cancel = False
    
      If Me.Saved = False Then Me.Save
      'Workbook will be saved & closed if all cells in UsedRange are filled
      End If



    '
    ' CreatingRawData Macro: (manually recorded)
    '

    Cells.Select
    Selection.Copy
    Sheets(" ClientSatisfactionForm").Select
    Sheets.Add
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Rows("1:3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A:A,D:D,F:F,H:H,J:J,L:L,N:N,P:P").Select
    Range("P1").Activate
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    Range("A:A,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X").Select
    Range("X1").Activate
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    Range("A:A,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z").Select
    Range("Z1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("B:B").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "SurveyCode"
    Range("A1").Select



  '
  ' Exporting Data:
  '

   Dim wbkExport As Workbook
   Dim shtToExport As Worksheet

   Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
   Set wbkExport = Application.Workbooks.Add
   shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
   Application.DisplayAlerts = False                       'Possibly overwrite without asking
   wbkExport.SaveAs Filename:="E:\Projects\Client Satisfaction Survey\ClientSatisfactionSurvey.csv", 
   FileFormat:=xlCSV

  Application.DisplayAlerts = True
  wbkExport.Close SaveChanges:=False
  Application.DisplayAlerts = False
  Application.Quit




 End Sub

Below, please see the Worksheet image screenshot (it's too wide to fit all the fields). Data range - from A1:Z3 contains some empty cells - it's my header. Doesn't have to be checked on empty cells...

Please try by shifting ````CreatingRawData Macro:```` code just before ````If Me.Saved = False Then Me.Save```` so that Macro will perform all the intended operation before closure & finally will save and close. — Puntal, Aug 20 '20 at 08:00
@Puntal Just did... no luck ( 1st - it only shows empty cells on the 1st four cells, and 2nd - it still not working correctly - creates "Sheet1" and not removes it from the Worksheet; allows empty cells to be in my csv... ... — Hell-1931, Aug 20 '20 at 08:15
Can you post image of your data with Row no. & college no. visible in it? Further in ````lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column```` you are using 1st row to find lastCol, whereas in ````Set emptyCells = sh.Range(sh.Cells(5, 1), .......```` start point of your Range is from 5th row. I suspect it is causing issues to you. Try changing ````lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column```` to ````lastCol = sh.Cells(5, Columns.Count).End(xlToLeft).Column````. — Puntal, Aug 20 '20 at 08:27
@Puntal Actually, if I copy CreatingRawData and ExportingData right after NoBlanks and removing If Me.Saved - it almost works.... I only have to figure - why soes it only shows 4 empty records, while have to show all empty... — Hell-1931, Aug 20 '20 at 08:29
@Puntal Regarding your very last comment - I start from cell5 because I have header on the 1st four cells (rows), and there are many empty cells there - just formatted in grey color with the Survey name in the middle. If I'd use from cell1 - then - it would show all these blanks on my header too... Besides, this worked perfect without my manual macro recording and export.... — Hell-1931, Aug 20 '20 at 08:32
Using things like `Activate`, `ActiveSheet` and `Select` are highly not recommended. Have a read of [this](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Zac, Aug 20 '20 at 08:32
@Hell-1931 please share image of your data sheet with Column no. & Row no. That would make things way clearer to understand. — Puntal, Aug 20 '20 at 09:30
@Puntal I figured my problem, thx to you ))! If I'd remove the Worksheet's header and change Set emptyCells = sh.Range(sh.Cells(5, 1),..... to Set emptyCells = sh.Range(sh.Cells(1, 1),....., and paste MacroRecording + MacroExport after Else No Blanks of the "Checking on empty cells:" action - everything works! So the problem was that I used cell 5, instead of 1 I would like to keep that header (where it says - Satisfaction Survey etc) - the Range A1:Z3 - all the formatted and empty cells area — Hell-1931, Aug 20 '20 at 10:41
Is there any way - in the "Checking on empty cells:" - to somehow say - to check from A5 cell (and ignore those A1:Z3)? — Hell-1931, Aug 20 '20 at 10:41
@Hell-1931 I have pasted below modified code, by deleting unnecessary lines causing clutter. I hope it works well for you. Your above query will be taken care of by ````lastCol = sh.Cells(4, Columns.Count).End(xlToLeft).Column```` & ````sh.Range(Cells(4, 1), Cells(lastRow, lastCol)).Interior.ColorIndex = 0````. — Puntal, Aug 20 '20 at 12:05
If you want to define range of ````emptyCells```` starting row no. 5 then, simply replace ````4```` by ````5```` in lines from your code that I have mentioned above. — Puntal, Aug 20 '20 at 12:13

score 1 · Accepted Answer · answered Aug 20 '20 at 12:03

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

Set sh = ActiveSheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row

lastCol = sh.Cells(4, Columns.Count).End(xlToLeft).Column

On Error GoTo NoBlanks
Set emptyCells = sh.Range(sh.Cells(4, 1), sh.Cells(lastRow, lastCol)). _
SpecialCells(xlCellTypeBlanks)

    If Not emptyCells Is Nothing Then
    
        MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
        emptyCells.Interior.Color = RGB(255, 0, 255)
        Cancel = True
        
    Else    

NoBlanks:
    
        Cancel = False
        sh.Range(Cells(4, 1), Cells(lastRow, lastCol)).Interior.ColorIndex = 0
        
        '''''''''''''''''''''''''''''''''''''''''''
        'Select & Format Data
        '''''''''''''''''''''''''''''''''''''''''''
        Cells.Copy
        'ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets("Sheet1")
        ActiveWorkbook.Sheets.AddAfter:=ActiveWorkbook. _ Worksheets("ClientSatisfactionForm")
        
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        ThisWorkbook.Sheets(2).Rows("1:3").Delete Shift:=xlUp
    
        Sheets(2).Cells.EntireColumn.AutoFit
    
        Sheets(2).Range("A:A,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z").Delete _
        Shift:=xlToLeft

        With ThisWorkbook.Sheets(2)
          .Columns("B:B").NumberFormat = "m/d/yyyy"
          .Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
          'By the way there won't be any row available with blank cells because of code above
        End With
        
        '
        ' Exporting Data:
        
         Dim wbkExport As Workbook
         Dim shtToExport As Worksheet
        
         Set shtToExport = ThisWorkbook.Worksheets(2)     'Sheet to export as CSV
         Set wbkExport = Application.Workbooks.Add
         shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
         Application.DisplayAlerts = False          'Possibly overwrite without asking
         wbkExport.SaveAs Filename:="D:\ClientSatisfactionSurvey.csv", FileFormat:=xlCSV
        
        Application.DisplayAlerts = True
        wbkExport.Close SaveChanges:=False
        Application.DisplayAlerts = False
              
        If Me.Saved = False Then Me.Save
        'Workbook will be saved & closed if all cells in UsedRange are filled
    End If

End Sub

Executing several actions within Before_Close

1 Answers1

Linked