I encountered the following code:
Sub HideSheets()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> ActiveSheet.Name Then
Sht.Visible = xlSheetHidden
End If
Next Sht
End Sub
What it does is to use a loop to hide all worksheets in the active workbook, except the active sheet. What is xlSheetHidden and why is it not defined?
Its an enumeration. Normally something like this would be True or False, but here we have three possibilities, including xlSheetVeryHidden
Related
I have a macro that generates a lot of worksheets and charts. There's also various subroutines that run so the names and quantity of each worksheet/chart generated is never the same. What is constant is my HOME worksheet which is the UI for the user and I want it to be unaffected.
I found a similar question here about deleting all worksheets except the one you are working with (i.e. HOME). Here's what I have so far.
Sub ZRESET()
Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Sheets("HOME").Select
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Name <> "HOME" Then
ws.Delete
End If
If Chart.Name = "" Then
Charts.Delete
End If
Next
Application.DisplayAlerts = True
Range("B5:E5,B9:E9,B13:E13,B14:E14").ClearContents
Range("A1").Select
End Sub
The worksheets delete fine, the hang up I have is the charts. I tried various attempts to remove charts and sometimes they work (i.e placing Charts.Delete outside of a FOR loop and IF statement). But this requires me to actually have a chart in the workbook. Sometime the user can just develop worksheets but no charts.
Any advice to continue my goal of deleting SHEETS and/or CHARTS, while keeping my HOME sheet intact?
Option Explicit
Sub GetRid()
Dim ASheet As Worksheet
Dim AChart As Chart
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'** first scan for and delete all non HOME worksheets ***
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
ASheet.Delete
End If
Next
'** Now scan and delete any ChartSheets ****
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub AllSheetsAndcharts()
Dim AChart As ChartObject
Dim ASheet As Worksheet
Application.DisplayAlerts = False
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
For Each AChart In ASheet.ChartObjects
AChart.Delete
Next
ASheet.Delete
End If
Next
Application.DisplayAlerts = False
End Sub
I know it is because of the "Or" but I was hoping someone could explain why it does not work.
If (Sheet.Name <> "Dep 1" Or "Test") Then
^
Sub DeleteSheet()
Dim Sheet As Worksheet
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Sheets
If (Sheet.Name <> "Dep 1" Or "Test") Then
Sheet.Delete
End If
Next Sheet
Application.DisplayAlerts = False
End Sub
My "Two-cents" to this post:
Try to use meaningful variable names, but NOT ones that are too close to Excel's saves words. Dim Sheet is ~ 85% similar to Sheets, which is a type of Object, I've seen so many posts here that people get cell with Cells mixed-up and get a run-time error.
I've switched your If with Select Case .Name, this way, if in the future you have add more Worksheets or want to perform other actions on other Worksheets, it will be easier to modify the code.
Code
Option Explicit
Sub DeleteSheet()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
With ws
Select Case .Name
Case "Dep 1", "Test"
' do nothing for now
Case Else
.Delete
End Select
End With
Next ws
Application.DisplayAlerts = True ' <-- restore setting
End Sub
The macro appears to loops through all of the worksheets fine now. However, is there a way that I can make it so the macro does not get applied to a specific worksheet in my workbook, but does get applied to all other worksheets?
Sub FormatSheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Columns("A:J").Select
Selection.AutoFilter
Columns("A:J").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Next ws
End Sub
I created a dataset to test this out and found that the code worked just fine. So it must be something related to your specific data/worksheets. I would see if 2 sheets works, or try making a smaller sample on another workbook and see if it works. Sorry I'm not more helpful.
Consider this approach.
Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
With ws.UsedRange
.Resize(.Rows.Count-1).Offset(1, 0).ClearContents
End With
End If
Next ws
End Sub
When we have a workbook with several sheets
sheet_1, sheet_2, ..., sheet_n, sheet_constant
and we like to create n workbooks with pairs of two sheets
workbook 1: sheet_1, sheet_constant
workbook 2: sheet_2, sheet_constant
...
workbook n: sheet_n, sheet_constant
how can we do this with vba?
I know we can copy one sheet with this
Sub CopySheet()
ThisWorkbook.Sheets("sheet_1").Copy
Application.Dialogs(xlDialogSaveAs).Show
End Sub
And I tried this with no success
Sub CopySheets()
ThisWorkbook.Sheets("sheet_1").Copy
ThisWorkbook.Sheets("sheet_constant").Copy
Application.Dialogs(xlDialogSaveAs).Show
End Sub
You can use:
Sub CopySheets(VariableSheetName As String, ConstantSheetName As String)
ThisWorkbook.Sheets(Array(VariableSheetName, _
ConstantSheetName)).Copy
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Note: Copying both sheets at once has the advantage that any references between the sheets won't suddenly become links to the original workbook, which is what could happen if you copy the sheets one after the other.
This subroutine can be called as:
CopySheets "sheet_1", "sheet_constant"
CopySheets "sheet_2", "sheet_constant"
CopySheets "sheet_3", "sheet_constant"
or in a loop (assuming your sheets do have numbers in them)
For i = 1 To 3
CopySheets "sheet_" & i, "sheet_constant"
Next
or, if you want all sheets copied:
For Each ws in Worksheets
If ws.Name <> "sheet_constant" Then
CopySheets ws.Name, "sheet_constant"
End If
Next
Based on #YowE3K answer, this one is a little more generic and hase autoSave option.
Sub CopySheets()
Dim ws As Worksheet
ChDir (ThisWorkbook.Path)
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "sheet_constant" Then GoTo NextIteration
ThisWorkbook.Sheets(Array(ws.Name, "sheet_constant")).Copy
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs Filename:=ws.Name, FileFormat:=xlNormal, CreateBackup:=False
ActiveWorkbook.Saved = True
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
NextIteration:
Next ws
End Sub
I have a macro that copy/pastes a selection from one worksheet (Sheet1), to another worksheet (Notes). It works well. Now I want to first check if that worksheet exists. If it does not exist, I want to create it, then continue with the copy/pasting the selection.
When the "Notes" worksheet exists, the copy/paste works fine.
If the worksheet does not exist, it creates it, but the paste operation doesn't work. I don't get any errors. I have to rerun the macro and then the paste works (since the worksheet has already been created). Any ideas on what I missed?
Sub Copy2sheet()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim mySheetName As String, mySheetNameTest As String
mySheetName = "Notes"
'create worksheet at end of workbook if it does not exist
On Error Resume Next
mySheetNameTest = Worksheets(mySheetName).Name
If Err.Number = 0 Then
GoTo CopyPasteSelection
Else
Err.Clear
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'copy/paste selection to Notes worksheet
CopyPasteSelection:
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Notes")
Selection.Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
When you do the Add, the activesheet becomes the new worksheet and your previous Selection is lost...............you must "remember" it before the Add:
Sub Copy2sheet()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim mySheetName As String, mySheetNameTest As String
mySheetName = "Notes"
Dim RtoCopy As Range
Set RtoCopy = Selection
'create worksheet at end of workbook if it does not exist
On Error Resume Next
mySheetNameTest = Worksheets(mySheetName).Name
If Err.Number = 0 Then
GoTo CopyPasteSelection
Else
Err.Clear
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'copy/paste selection to Notes worksheet
CopyPasteSelection:
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Notes")
RtoCopy.Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Pay attention to the three lines referencing RtoCopy .
You have On Error Resume Next in your code. First time through it goes on its merry way. The second time through the Error check triggers the creation of the new tab.
On Error Resume Next is bad. Don't use it.
See this question for more information on solving your problem How to check whether certain sheets exist or not in Excel-VBA?
You should first activate and select the sheet and range to be copied. This works.
CopyPasteSelection:
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Notes")
Worksheets("Sheet1").Activate 'Activete "Sheet1"
Worksheets("Sheet1").Range("A1").Select 'Select the range to be copied
'Then copy selection
Selection.Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
I suggest using Function for more re-usability:
A dirty and fast way:
Function isWorksheetValid(wsName As String)
ON Error Goto ErrHndl
Dim ws as Worksheet
Set ws = Sheets(wsName)
isWorksheetValid = True
Exit Function
ErrHndl:
isWorksheetValid = False
End Function
A correct but a bit slower way:
Function isWorksheetValid(wsName As String)
ON Error Goto ErrHndl
Dim ws as Worksheet
For Each ws in Sheets
If (UCASE(ws.Name) = UCASE(wsName)) Then
isWorksheetValid = True
Exit Function
End If
Next
ErrHndl:
isWorksheetValid = False
End Function
Now you need just use it like this:
If (isWorksheetValid(mySheetName) Then
' Add your code here
End If