I need to be able to hide all sheets apart from the ones in the array. I have written the code for the array but am now stuck for the rest.
Sub ShowHideWorksheets()
arr = Array("Readme", "Compliance cert", "Cash Balances", "Occupancy Report", "ALPH", "BC", "Bish",
"GC", "HS", "STB", "WOL", "GroupCo", "OpCos", "RCG_ALL")
For Each Value In arr
Next Value
End Sub
Any help will be appreciated.
Hide Worksheets
Option Explicit
Sub hideWorksheets()
Dim arr As Variant
arr = Array("Readme", "Compliance cert", "Cash Balances", _
"Occupancy Report", "ALPH", "BC", "Bish", "GC", "HS", "STB", _
"WOL", "GroupCo", "OpCos", "RCG_ALL")
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
For Each ws In wb.Worksheets
If IsError(Application.Match(ws.Name, arr, 0)) Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Sub showAllWorksheets()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.Visible = xlSheetHidden Then ws.Visible = xlSheetVisible
Next ws
End Sub
This worked for me
Sub ShowHideWorksheets()
arr = Array("Readme", "Compliance cert", "Cash Balances", "Occupancy Report", "ALPH", "BC", "Bish", "GC", "HS", "STB", "WOL", "GroupCo", "OpCos", "RCG_ALL")
Dim sh As Worksheet, foundSheet As Boolean
For Each sh In Worksheets
For Each Value In arr
If sh.Name = Value Then
foundSheet = True
Exit For
End If
Next Value
If Not foundSheet Then
sh.Visible = xlSheetHidden
End If
foundSheet = False
Next sh
End Sub
Related
I have put together the code below to hide named worksheets using a Checkbox. The workbook also contains sheets with the generic names like Sheet1, Sheet2, etc and I would like to be able to hide all sheets whose name contains the word "Sheet" from the same Checkbox.
Is this possible?
Thanks
Private Sub CheckBox1_Click()
Application.ScreenUpdating = False
If CheckBox1 = False Then
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = False
Else:
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = True
End If
Application.ScreenUpdating = False
End Sub
If you really want hiding sheets, please use the next code. It hides all sheets where their name starts with ""Sheet":
Private Sub CheckBox1_Click()
Dim sh As Worksheet
For Each sh In Worksheets
If left(sh.name, 5) = "Sheet" Then
sh.Visible = xlSheetVeryHidden
End If
Next
End Sub
Hide Worksheet With Pattern
Reminder
At least one of all sheets in a workbook has to be visible.
There is a third 'visibility' parameter xlSheetHidden which is not considered in this solution.
You can hide multiple worksheets in one go by using an array of worksheet names (fast), but you have to loop through the array to unhide each of them (slow).
The Code
Option Explicit
Private Sub CheckBox1_Click()
Const WorksheetPattern As String = "ShEeT*"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsArr As Variant
Application.ScreenUpdating = False
If CheckBox1 Then ' Hide
wsArr = WorksheetNamesToArray(wb, WorksheetPattern)
wb.Worksheets(wsArr).Visible = xlSheetHidden ' also 0 or False
Else ' UnHide
wsArr = WorksheetNamesToArray(wb, WorksheetPattern, xlSheetHidden)
Dim n As Long
For n = 1 To UBound(wsArr)
wb.Worksheets(wsArr(n)).Visible = xlSheetVisible ' also -1 or True
Next n
End If
Application.ScreenUpdating = True
End Sub
Function WorksheetNamesToArray( _
ByVal wb As Workbook, _
ByVal WorksheetPattern As String, _
Optional ByVal isVisible As XlSheetVisibility = xlSheetVisible) _
As Variant
If Not wb Is Nothing Then
Dim wsCount As Long: wsCount = wb.Worksheets.Count
Dim wsArr() As String: ReDim wsArr(1 To wsCount)
Dim ws As Worksheet
Dim n As Long
For Each ws In wb.Worksheets
If UCase(ws.Name) Like UCase(WorksheetPattern) Then
If ws.Visible = isVisible Then
n = n + 1
wsArr(n) = ws.Name
End If
End If
Next ws
ReDim Preserve wsArr(1 To n)
WorksheetNamesToArray = wsArr
End If
End Function
I am currently using the following code to remove classifications I do not require in my tables:
Sub RemoveOldPlatforms()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("RAW")
ws.Range("$A$1:$J$100000").AutoFilter Field:=2, Criteria1:=Array("Coniferous", "Broafleaf", "Mixedwood", "Water", "Exposed Land / Barren", "Urban / Developed", "Greenhouses", "Shrubland", "Wetland", "Grassland"), Operator:=xlFilterValues
ws.Range("$A$2:$J$100000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.Range("$A$1:$J$100000").AutoFilter
End Sub
As is, I am specifying a single identified worksheet, but how do I loop it through all worksheets in my workbook (20+)?
Hi pretty simple code to check every worksheets in a workbook,
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
'called once per worsheet
Next ws
Here I loop trough all the worksheet to find all tables availiable in ANOTHER workbook and display it inside a ComboBox
Private Sub UpdateTablesFromFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim tbl As ListObject
Dim text As String
Dim I As Integer
Dim FileToOpen As String
FolderPath = Application.ActiveWorkbook.Path
FilePath = FolderPath & "\" & ComboBox1.Value
Application.ScreenUpdating = False
Workbooks.Open Filename:=FilePath
For Each ws In Workbooks(ComboBox1.Value).Worksheets
For Each tbl In ws.ListObjects
text = ws.Name & "\" & tbl.Name
ImportForm1.ComboBox2.AddItem text 'add every tables in my entire workbook inside the ComboBox2
Next tbl
Next ws
Workbooks(ComboBox1.Value).Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
You should do something like this:
Sub EnteringAllSheetsOneByOne()
For Each ws In Excel.Workbooks("YourWorkbook.xlsx").Worksheets
ws.Select
Call RemoveOldPlatforms(ws) 'must to be called here and use ws as parameter
Next ws
MsgBox "Done!"
End Sub
' Just add the "ws" parameter to your current sub
Sub RemoveOldPlatforms(ws As Object)
'Dim ws As Worksheet
'Set ws = ThisWorkbook.Worksheets("RAW")
ws.Range("$A$1:$J$100000").AutoFilter Field:=2, Criteria1:=Array("Coniferous", "Broafleaf", "Mixedwood", "Water", "Exposed Land / Barren", "Urban / Developed", "Greenhouses", "Shrubland", "Wetland", "Grassland"), Operator:=xlFilterValues
ws.Range("$A$2:$J$100000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.Range("$A$1:$J$100000").AutoFilter
End Sub
Note: Please pay atention to all I've commented, Dim and Set in this case are not necessary
I'm trying to set up a spreadsheet that duplicates the previous worksheet into a new tab daily.
I have it set up to create a new worksheet and rename it daily, but I can't figure out the duplication aspect.
Sub AddDayWkst()
Dim ws As Worksheet
Dim strName As String
Dim bCheck As Boolean
On Error Resume Next
strName = Format(Date, "mm-dd-yy")
bCheck = Len(Sheets(strName).Name) > 0
If bCheck = False Then
Set ws = Worksheets.Add(Before:=Sheets(1))
ws.Name = strName
End If
End Sub
I need to duplicate the previous day's worksheet and paste it into the new worksheet.
Sub AddDayWkst()
Dim ws As Worksheet
Dim strNewName As String, strOldName As String
Dim bValid As Boolean
strNewName = Format(Date, "mm-dd-yy")
strOldName = Format(Date - 1, "mm-dd-yy")
bValid = WorksheetExists(strOldName)
If bValid Then
Set ws = Sheets(strOldName)
ws.Copy before:=Worksheets(1)
Worksheets(1).Name = strNewName
End If
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
completely new to VBA, would appreciate help with the following problem:
Currently using Sub GoFC() in module to hyperlink shapes on a worksheet ("Menu") to other hidden worksheets (shapes and worksheet text match)
I would like to use Sub GoFC() for shapes in more than one sheet, but the code refers only to one sheet by name. In other words I want for the worksheet "Menu" and worksheet "Menu2" to allow all the shapes in them to run the same macro.
I sincerely hope this makes sense.
This is the code in module:
Sub GoFC()
shtName=Sheets("Menu").Shapes(Application.Caller).TextFrame2.TextRange.Text
Sheets(shtName).Visible = True
Application.Goto Sheets(shtName).Range("A1")
End Sub
This is the code in the worksheet "Menu":
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim shtName As String
'shtName = Target.Name
If InStr(1, Target.SubAddress, "'") = 1 Then
Sh = Mid(Target.SubAddress, 2, Len(Target.SubAddress) - 5)
Else
Sh = Left(Target.SubAddress, InStr(1, Target.SubAddress, "!") - 1)
End If
Sheets(Sh).Visible = True
Sheets(Sh).Select
End Sub
Maybe like that
Sub GoFC()
Dim sht As Worksheet
Dim wb As Workbook
Dim shtName As String
Set wb = ActiveWorkbook
Set sht = wb.ActiveSheet
shtName = sht.Shapes(Application.Caller).TextFrame2.TextRange.Text
If Not wsExists(shtName, wb) Then wb.Sheets.Add.Name = shtName
wb.Sheets(shtName).Visible = True
wb.Sheets(shtName).Activate
wb.Sheets(shtName).Range("A1").Select
End Sub
Function wsExists(wsName As String, wb As Workbook) As Boolean
Dim ws
For Each ws In wb.Sheets
wsExists = (wsName = ws.Name): If wsExists Then Exit Function
Next ws
End Function
There is runtime error 91 on for loop need help!!
Sub clearSheet(WSName As String)
Dim ws As Worksheet
Set ws = Nothing
With ActiveWorkbook
Dim blWSExists As Boolean
blWSExists = False
For i = 1 To .Sheets.Count
If .Sheets(i).Name = WSName Then
blWSExists = True
.Sheets(i).Activate
.Sheets(i).Visible = xlSheetVisible
End If
Next
If Not blWSExists Then
Set ws = .Sheets.Add
ws.Move after:=.Sheets(.Sheets.Count)
ws.Name = WSName
ws.Visible = xlSheetVisible
End If
.Sheets(WSName).AutoFilterMode = False
.Sheets(WSName).Cells.Clear
.Sheets(WSName).UsedRange.ClearOutline
.Sheets(WSName).Cells.ClearFormats
End With
End Sub
Try that:
Dim ws As Worksheet
Dim blWSExists As Boolean
blWSExists = False
For Each ws In Worksheets
If ws.Name = WSName Then
blWSExists = True
End If
Next
If Not blWSExists Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSName
End If
Set ws = ActiveWorkbook.Sheets(WSName)
ws.AutoFilterMode = False
ws.Cells.Clear
ws.UsedRange.ClearOutline
ws.Cells.ClearFormats
ws.Activate
You can use Cells.Delete() to clear everything on a Worksheet:
Sub clearSheet(WSName As String)
Dim s As Object
For Each s in ThisWorkbook.Sheets
If s.Name = WSName Then
s.Visible = xlSheetVisible
If TypeOf s Is worksheet Then s.Cells.Delete ' not all Sheets have cells, but all Worksheets do
Exit Sub ' to ignore the rest of the code if the Sheet exists
End If
Next
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = WSName
End Sub
or just delete the sheet and add new to clear absolutely everything associated with the sheet:
Sub clearSheet(WSName As String)
On Error Resume Next
Sheets(WSName).Delete
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WSName
End Sub