Set Print Area for All Visible Sheets in Workbook - excel

Attempting to set the print area for all visible sheets in my workbook however I am getting an "object required" error on line PageSetup.PrintArea = "$B$2:$K$55
Any help on how to fix this error is appreciated.
Here is a copy of my full code.
Private Sub YesPrint_Click()
Dim Sheet As Worksheet
Dim CompareTool As Workbook
Dim Sheetname As String
Set CompareTool = ThisWorkbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
For Each Sheet In CompareTool.Worksheets
If Sheet.Visible = True Then
Sheet.Activate
With ActiveSheet.Name
Range("B2:K55").Select
PageSetup.PrintArea = "$B$2:$K$55"
End With
End If
Next Sheet
End Sub

It looks like there are two issues with the code provided.
First, There is a syntax error in the with statement. Each property accessed inside the with statement should have a dot before it.
Second, the ActiveSheet.Name is not the object that includes the Range and PageSetup Method/object. It's the ActiveSheet object.
The corrected code should look like:
With ActiveSheet
.Range("B2:K55").Select
.PageSetup.PrintArea = "$B$2:$K$55"
End With
The MSDN article for PageSetup provides an example as well:
https://msdn.microsoft.com/en-us/library/office/ff196103.aspx

Related

VBA loop through all worksheets in workbook

I have tried following VBA code, where I want to run this code for all available worksheets in active workbook, I think I am making small mistake and as I am beginner I am not able to find it out, please help to fix it up
Sub ProtectFormulas()
Dim strPassword As String
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
.Protect AllowDeletingRows:=True
strPassword = 123456
ActiveSheet.Protect Password:=strPassword
Next ws
End With
End Sub
Any help would be appriciated by word of thanks.
There are 3 issues with your code:
There is no With block.
The following 2 lines will error if there is no formula in one of the sheets:
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
Because if there is no formula then .Cells.SpecialCells(xlCellTypeFormulas) is Nothing and therefore nothing has no .Locked and no .FormulaHidden methods.
You mix using Sheets and Worksheets. Note that those are not the same!
Sheets is a collection of all type of sheets (worksheets, chart sheets, etc)
Worksheets is a collection of only type worksheet
If you declare Dim ws As Worksheet and there is for example a chart sheet in your file, then For Each ws In Sheets will error because you try to push a chart sheet into a variable ws that is defined as Worksheet and cannot contain a chart sheet. Be as specific as possible and use Worksheets whenever possible in favour of Sheets.
The following should work:
Option Explicit
'if this is not variable make it a constant and global so you can use it in any procedure
Const strPassword As String = "123456"
Sub ProtectFormulas()
'Dim strPassword As String
'strPassword = "123456" 'remove this here if you made it global
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
.Activate 'I think this is not needed
.Unprotect Password:=strPassword 'unprotect probably needs your password too or this will not work once the worksheet was protected.
.Cells.Locked = False
Dim FormulaCells As Range
Set FormulaCells = Nothing 'initialize (because we are in a loop!)
On Error Resume Next 'hide error messages (next line throws an error if no forumla is on the worksheet
Set FormulaCells = .Cells.SpecialCells(xlCellTypeFormulas)
On Error Goto 0 ' re-enable error reporting! Otherwise you won't see errors if they occur!
If Not FormulaCells Is Nothing Then 'check if there were formulas to prevent errors if not
FormulaCells.Locked = True
FormulaCells.FormulaHidden = True
End If
.Protect AllowDeletingRows:=True, Password:=strPassword
End With
Next ws
End Sub

Access a work book and create new sheet with name value sets

I want to open an existing excel work book and add a sheet with given name.. All this has to be done from a different excel work book
I am able to open the existing work book from a blank work book by executing code. But when I tired to add a new sheet to the opened work book, my code is adding the new sheet in the execution work book (Blank work book)
Sub Valuesets()
Dim ws As Worksheets
Dim PTable1 As PivotTable
Dim sheet As Sheets
Set wb = ActiveWorkbook
Workbooks.Open("C:\Users\user\Desktop\workbook1.xlsb").Worksheets("Data").Activate
On Error Resume Next
Application.DisplayAlerts = False
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Test-1"
Application.DisplayAlerts = True
Set CSheet = Worksheets("Data")
Set SSheet = Worksheets("Test-1")
End Sub
You should set your opened workbook into a variable OpenWb so you can access it to add a sheet in this specific workbook OpenWb.Sheets.Add. The same with the data sheet and the new sheet. Always avoid using .Activate, ActiveSheet and .Select like described in How to avoid using Select in Excel VBA.
Also make sure you don't use On Error Resume Next as you did. This line hides all error messages until End Sub or On Error Goto 0 but the errors still occur. You just hide their messages. If you don't see the errors you cannot fix them. If you don't tell the user that something went wrong, he will continue with that wrong status!
Always implement a proper error handling: VBA Error Handling – A Complete Guide.
Using On Error Resume Next (unless you know in which rare cases this can be used) is a very bad practice and will produce more issues instead of preventing issues.
Sub Valuesets()
Dim OpenWb As Workbook
Set OpenWb = Workbooks.Open("C:\Users\user\Desktop\workbook1.xlsb")
Dim wsData As Worksheet
Set wsData = OpenWb.Worksheets("Data")
Application.DisplayAlerts = False
Dim NewSheet As Worksheet
Set NewSheet = OpenWb.Sheets.Add(Before:=wsData)
NewSheet.Name = "Test-1"
Application.DisplayAlerts = True
End Sub

Excel VBA copy content from one Sheet into other Workbook sheet

I want to be able to select a workbook and then copy the content from that workbook (sheet 1) into my current active workbook where I run the macro. I've been looking at some answers here on StackOverflow to similar questions and got the following code (see below).
The selection of a file is currently working fine, but when I run the macro it throws an error
Runtime error "438": Object does not support that method or property`
(please note, that the error comes in my native language and is just translated by me)
Sadly no object is marked that he relates to, so I can't really make out what problem he has. Yet, I guess it is a problem with the PasteSpecial in the last line of function GetTemplateData, but that code should be alright (what is it supposed to do? Save the data into the first sheet of the give workbook activeWorkbook) and pass the reference back go GeneratedValues-routine.
Option Explicit
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
'Get The Template Data
Private Function GetTemplateData(activeWorkbook As Workbook) As Worksheet
Dim templateWorkbook As Workbook
'Grab the Template Worksheet
Set templateWorkbook = UseFileDialogOpen
'Select all Content
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy
'activeWorkbook.Sheets(activeWorkbook.Sheets.Count).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
activeWorkbook.Sheets(1).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
End Function
'From https://learn.microsoft.com/de-de/office/vba/api/excel.application.filedialog
'Select the Workbook containing the Exported Template-Stories by User Selection
Function UseFileDialogOpen() As Workbook
Dim lngCount As Long
Dim filePath As String
Dim templateBook As Workbook
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
Set templateBook = Workbooks.Open(.SelectedItems(1))
' Display paths of each file selected
'For lngCount = 1 To .SelectedItems.Count
' MsgBox .SelectedItems(lngCount)
'Next lngCount
End With
templateBook
End Function
I believe all of your problems originate here:
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
ActiveWorkbook is a defined "variable" in VBA, so it is confused as to why you are trying to reassign it. Try using a different variable name instead.
Note: although ActiveWorksheet is not a defined variable in VBA, it is close in name to ActiveSheet, so I would also change that variable name to something different just so to not confuse you when writing future code.
You could try something similar to this:
Sub CopyContentsFromOtherWorkbook()
Dim wb As Workbook
Dim twb As Workbook
filePath = "C:\File.xlsx"
Set wb = Workbooks.Open(filePath)
wb.Sheets(1).Range("A1:Z10000").Copy
Set twb = ThisWorkbook
twb.Sheets(1).Range("C1").PasteSpecial xlPasteValues
wb.Close
twb.Save
End Sub

Delete multiple Excel Sheets in VBA

I am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.

Easy VBA Macro to list all worksheets generates error: Type Mismatch

I'm making a ExcelComparer but I bump into a probably obvious error, I clearly missed something.
I run a vba macro in Excel 2007
The exact error I get is "Run-time Error 13: Type Mismatch"
This happens when the loop tries to fetch the second worksheet.name .
So, the first sheetname is returned fine
Below you find the macro
Thanks in advance,
L
Sub compare()
Dim strWorkbook1, strWorkbook2 As String
Dim Workbook1, Workbook2 As Workbook
strWorkbook1 = Worksheets("Sheet1").Range("C5") & Worksheets("Sheet1").Range("D5")
strWorkbook2 = Worksheets("Sheet1").Range("C6") & Worksheets("Sheet1").Range("D6")
Set xlapp = CreateObject("Excel.application")
Set Workbook1 = xlapp.Workbooks.Open(strWorkbook1)
xlapp.Visible = False
Dim ws As Worksheet
For Each ws In Workbook1.Sheets
'ws.Select
If Not ws.Visible = xlSheetVeryHidden Then
MsgBox (ws.Name)
End If
Next ws
xlapp.Close
End Sub
Use this for your For loop:
For Each ws In Workbook1.Worksheets
From MSDN the difference between the Sheets and Worksheets properties are:
This property does not return macro sheets, charts, or dialog sheets.
Use the Sheets property to return those sheets as well as worksheets.
You can also use the specialized properties Excel4MacroSheets and
Excel4IntlMacroSheets to return macro sheets and the Charts property
to return charts.
[Edited my original response as I had tested with different variables rendering my comment incorrect]
In addition the back end of your code will fail as you can't set the Excel Application to close with this line xlapp.Close
You should
close the automated workbook (Workbook1.Close False)
quit the automated application (xlapp.Quit)
Ensure the automated application is destroyed (Set xlapp = Nothing)a
The working part of your code should look like this
Dim ws As Worksheet
For Each ws In Workbook1.WorkSheets
If Not ws.Visible = xlSheetVeryHidden Then MsgBox (ws.Name)
Next ws
Workbook1.Close False
xlapp.Quit
Set xlapp = Nothing
End Sub

Resources