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
solved Executing several actions within Before_Close