VBA/Excel/Access/Word/Excel/Workbook

Add a new workbook and save it

 
Public Sub SaveActiveWorkbook()
  Application.Workbooks.Add
  Call Application.ActiveWorkbook.SaveAs("temp.xls")
End Sub

arranges the open workbooks in a tiled configuration

 
Private Sub AppEvent_NewWorkbook(ByVal Wb As Workbook)
    Application.Windows.Arrange xlArrangeStyleTiled
End Sub

Center workbook

 
Sub CenterBook()
    Dim bookWidth As Integer
    Dim bookHeight As Integer
    bookWidth = Application.UsableWidth
    bookHeight = Application.UsableHeight
    ActiveWindow.WindowState = xlNormal
    Workbooks("Center.xls").Windows(1).Width = bookWidth
    Workbooks("Center.xls").Windows(1).Height = bookHeight
    Workbooks("Center.xls").Windows(1).Left = 0
    Workbooks("Center.xls").Windows(1).Top = 0
End Sub

Check Whether a Sheet in an Open Workbook Exists

 
Function SheetExists(SName As String, Optional WB As workBook) As Boolean
    Dim WS As Worksheet
    If WB Is Nothing Then
        Set WB = ActiveWorkbook
    End If
    On Error Resume Next
        SheetExists = CBool(Not WB.Sheets(SName) Is Nothing)
    On Error GoTo 0
End Function
Sub CheckForSheet()
    Dim ShtExists As Boolean
    ShtExists = SheetExists("Sheet1")
    If ShtExists Then
        MsgBox "The worksheet exists!"
    Else
        MsgBox "The worksheet does NOT exist!"
    End If
End Sub

Check Whether a Workbook Is Open

 
Function BookOpen(Bk As String) As Boolean
    Dim T As Excel.workBook
    Err.clear "clears any errors
    On Error Resume Next
    Set T = Application.Workbooks(Bk)
    BookOpen = Not T Is Nothing
    
    Err.clear
    On Error GoTo 0
End Function
Sub OpenAWorkbook()
    Dim IsOpen As Boolean
    Dim BookName As String
    BookName = "yourFile.xlsm"
    IsOpen = BookOpen(BookName)
    If IsOpen Then
        MsgBox BookName & " is already open!"
    Else
        Workbooks.Open (BookName)
    End If
End Sub

Close a workbook and save it

 
Sub CloseWorkbook()
   Dim Workbook1 As Workbook
  
   Set Workbook1 = Workbooks.Open(FileName:=ThisWorkbook.Path & "\Temp.xls")
   Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
   Range("A1").EntireColumn.AutoFit
   Workbook1.Close SaveChanges:=True
End Sub

Controlling Worksheet Visibility

 
Sub SetWorksheetVisibility() 
    Dim myWorksheet As Worksheet 
    On Error Resume Next 
    Set myWorksheet = ThisWorkbook.Worksheets("Checks and Options") 
    Application.ScreenUpdating = False 
    ThisWorkbook.Worksheets("Sheet1").Visible = True 
    ThisWorkbook.Worksheets("Sheet2").Visible = True
    ThisWorkbook.Worksheets("Sheet3").Visible = True
    Application.ScreenUpdating = True 
    Set myWorksheet = Nothing 
End Sub

Count the Number of Workbooks in a Directory

 
Function NumFilesInCurDir(Optional strInclude As String = "")
    Dim myFileSystemObject As FileSystemObject
    Dim fld As folder
    Dim fil As file
    Dim subfld As folder
    Dim intFileCount As Integer
    Dim strExtension As String
      strExtension = "XLS"
      Set myFileSystemObject = New FileSystemObject
      Set fld = myFileSystemObject.GetFolder(ThisWorkbook.Path)
      For Each fil In fld.Files
        If UCase(fil.name) Like "*" & UCase(strInclude) & "*." & UCase(strExtension) Then
          intFileCount = intFileCount + 1
        End If
      Next fil
      For Each subfld In fld.SubFolders
          intFileCount = intFileCount + NumFilesInCurDir(strInclude)
      Next subfld
      NumFilesInCurDir = intFileCount
      Set myFileSystemObject = Nothing
End Function
Sub CountMyWkbks()
    Dim MyFiles As Integer
    MyFiles = NumFilesInCurDir("MrE*")
    MsgBox MyFiles & " file(s) found"
End Sub

Create a new workbook

 
Sub NewWorkbooks()
   Dim myWorkbook1 As Workbook
   Dim myWorkbook2 As Workbook
 
   Set myWorkbook1 = Workbooks.Add
   Set myWorkbook2 = Workbooks.Add
   Application.DisplayAlerts = False
   myWorkbook1.SaveAs FileName:="E:\SalesData1.xls"
End Sub

Create a workbook and save it as a new file

 
Public Sub SaveSpecificWorkbook2()
  
  Dim W As Workbook
  Set W = Application.Workbooks.Add
  Call W.SaveAs("temp2.xls")
  
End Sub

Creates a new workbook and adds it to the collection, reads the number of workbooks into a variable, and selects all worksheets in the active workbook:

 
Sub workbookAdd()
    Workbooks.Add
    numWorkbooks = Workbooks.Count
    Worksheets.Select
End Sub

Get workbook format

 
Sub GetFileFormat()
    Dim lFormat As Long
    Dim sFormat As String
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    
    lFormat = wb.FileFormat
    Select Case lFormat
        Case xlAddIn: sFormat = "Add-in"
        Case xlCSV: sFormat = "CSV"
        Case xlCSVMac: sFormat = "CSV Mac"
        Case xlCSVMSDOS: sFormat = "CSV MS DOS"
        Case xlCSVWindows: sFormat = "CSV Windows"
        Case xlCurrentPlatformText: sFormat = "Current Platform Text"
        Case xlDBF2: sFormat = "DBF 2"
        Case xlDBF3: sFormat = "DBF 3"
        Case xlDBF4: sFormat = "DBF 4"
        Case xlDIF: sFormat = "DIF"
        Case xlExcel2: sFormat = "Excel 2"
        Case xlExcel2FarEast: sFormat = "Excel 2 Far East"
        Case xlExcel3: sFormat = "Excel 3"
        Case xlExcel4: sFormat = "Excel 4"
        Case xlExcel4Workbook: sFormat = "Excel 4 Workbook"
        Case xlExcel5: sFormat = "Excel 5"
        Case xlExcel7: sFormat = "Excel 7"
        Case xlExcel9795: sFormat = "Excel 97/95"
        Case xlHtml: sFormat = "HTML"
        Case xlIntlAddIn: sFormat = "Int"l AddIn"
        Case xlIntlMacro: sFormat = "Int"l Macro"
        Case xlSYLK: sFormat = "SYLK"
        Case xlTemplate: sFormat = "Template"
        Case xlTextMac: sFormat = "Text Mac"
        Case xlTextMSDOS: sFormat = "Text MS DOS"
        Case xlTextPrinter: sFormat = "Text Printer"
        Case xlTextWindows: sFormat = "Text Windows"
        Case xlUnicodeText: sFormat = "Unicode Text"
        Case xlWebArchive: sFormat = "Web Archive"
        Case xlWJ2WD1: sFormat = "WJ2WD1"
        Case xlWJ3: sFormat = "WJ3"
        Case xlWJ3FJ3: sFormat = "WJ3FJ3"
        Case xlWK1: sFormat = "WK1"
        Case xlWK1ALL: sFormat = "WK1ALL"
        Case xlWK1FMT: sFormat = "WK1FMT"
        Case xlWK3: sFormat = "WK3"
        Case xlWK3FM3: sFormat = "WK3FM3"
        Case xlWK4: sFormat = "WK4"
        Case xlWKS: sFormat = "WKS"
        Case xlWorkbookNormal: sFormat = "Normal workbook"
        Case xlWorks2FarEast: sFormat = "Works 2 Far East"
        Case xlWQ1: sFormat = "WQ1"
        Case xlXMLSpreadsheet: sFormat = "XML Spreadsheet"
        Case Else: sFormat = "Unknown format code"
    End Select
    Debug.Print sFormat
End Sub

maximizes any workbook when it is activated

 
Private Sub AppEvent_WorkbookActivate(ByVal Wb as Workbook)
    Wb.WindowState = xlMaximized
End Sub

Open a workbook and then size it to fit just within the application window

 
Public Sub OpenBook()
    Workbooks.Open ActiveWorkbook.Path & "\MyWorkbook.xls"
    FitWindow
End Sub
Private Sub FitWindow()
    Dim winWidth As Integer
    Dim winHeight As Integer
    winWidth = Application.UsableWidth "Get the usable width of app window
    winHeight = Application.UsableHeight
End Sub

Open workbook by name

 
Sub Array2()
  Dim Data As Variant, myWorkbook As Workbook
  Dim i As Integer
  Data = Array("A", "B", "C", "D")
  For i = LBound(Data) To UBound(Data)
    Set myWorkbook = Workbooks.Open(FileName:=Data(i) & ".xls")
    MsgBox myWorkbook.Name
    myWorkbook.Close SaveChanges:=True
  Next i
End Sub

places the username in the footer of each sheet printed:

 
Private Sub AppEvent_WorkbookBeforePrint(ByVal Wb As Workbook,Cancel As Boolean)
    Wb.ActiveSheet.PageSetup.LeftFooter = Application.UserName
End Sub

Save workbook and close

 
Sub CloseWorkbook()
   Dim myWorkbook1 As workBook
 
   Set myWorkbook1 = Workbooks.Open(Filename:="E:\SalesData.xls")
   Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
   Range("A1").EntireColumn.AutoFit
   myWorkbook1.Close SaveChanges:=True
End Sub

The distinction between the Workbook and Window objects lies in an additional method that can be used to create a Window object

 
Sub newWindow()
    Windows(1).newWindow
End Sub

The Workbooks property is a member of the Application object and returns a reference to the Workbook object specified by the index value given in the parentheses.

 
Sub changePro()
    Workbooks(1).Windows(1).WindowState = xlNormal
    Workbooks(1).Windows(1).Width = 500
    Workbooks(1).Windows(1).Height = 300
End Sub

To close all open workbooks, use the Close method of the Workbooks collection object.

 
Sub closeDemo()
    Workbooks.Close
End Sub

To close a single workbook, use the Close method of the Workbook object. The Close method accepts three optional arguments (SaveChanges, FileName, and RouteWorkbook).

 
Sub save()
    Workbooks("MyWorkbook.xls").Close SaveChanges:=False
End Sub

To save a workbook from a VBA program, use either the Save methods of the Workbook object.

 
Sub saveWorkBook()
    Workbooks("MyWorkbook.xls").save
End Sub

To select the last Workbook object in the collection

 
Sub workbookSelect()
    Workbooks(Workbooks.Count).Activate
End Sub

Use Application object to save a workbook as a new file

 
Public Sub SaveSpecificWorkbook1()
  Application.Workbooks.Add
  Call Application.ActiveWorkbook.SaveAs("temp1.xls")
  Application.Workbooks("temp1.xls").SaveAs ("copy of temp1.xls")
End Sub

Use a String rather than an index value to reference a workbook

 
Sub workbookSelectName()
    Workbooks("MyWorkbook.xls").Activate
End Sub