I've been using the following VBA macro code below to hide all but the active worksheet:
Sub HideWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Are there any options to extend it so that it will hide all but the selected worksheets?
You need to access the Windows(#).SelectedSheets. One way is to hide all except ActiveSheet, then unhide those Selected.
Option Explicit
Sub HideWorksheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
' Hide all except activeone
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then ws.Visible = xlSheetHidden
Next
' Unhide selected worksheets
For Each ws In ThisWorkbook.Windows(1).SelectedSheets
ws.Visible = xlSheetVisible
Next ws
Application.ScreenUpdating = True
End Sub
Related
Attempting a macro that will set all selected sheets to have same cells visible as in the active sheet.
Example: if top-left cell is L76 on active sheet, then running this macro will set all selected worksheets to show L76 as the top left cell.
Cobbled this code together from examples found online but not sufficiently advanced in VBA to make it work.
Sub SetAllSelectedSheetsToSameRowColCell()
Dim rngSel As Range
Dim intScrollCol As Integer
Dim intScrollRow As Long
Dim oSheet As Object
If TypeName(Sh) = "Worksheet" Then
Set oSheet = ActiveSheet
Application.EnableEvents = False 'Unsure what this line is for
Sh.Activate
With ActiveWindow
intScrollCol = .ScrollColumn
intScrollRow = .ScrollRow
Set rngSel = .RangeSelection
End With
oSheet.Activate
Application.EnableEvents = True
End If
'Loop thru rest of selected sheets and update to have same cells visible
Dim oWs As Worksheet
For Each oWs In Application.ActiveWindow.SelectedSheets
On Error Resume Next
oWs.Range(rngSel.Address).Select
.ScrollColumn = intScrollCol
.ScrollRow = intScrollRow
Next
End Sub
References:
https://excel.tips.net/T003860_Viewing_Same_Cells_on_Different_Worksheets.html
VBA Macro To Select Same Cell on all Worksheets
Try this:
Sub ResetAllSheetPerspectives()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim dZoom As Double
lRow = ActiveWindow.ScrollRow
lCol = ActiveWindow.ScrollColumn
dZoom = ActiveWindow.Zoom
For Each ws In Application.ActiveWindow.SelectedSheets
ws.Activate
ActiveWindow.Zoom = dZoom
Application.Goto ws.Cells(lRow, lCol), True
Next ws
End Sub
Maybe this will help. Sets the top left cell of other sheets depending on the first sheet.
Sub Macro1()
Dim r As Range, ws As Worksheet
Sheets(1).Activate
Set r = ActiveWindow.VisibleRange.Cells(1)
For Each ws In Worksheets
If ws.Index > 1 Then
ws.Activate
ActiveWindow.ScrollRow = r.Row
ActiveWindow.ScrollColumn = r.Column
End If
Next ws
End Sub
This procedure sets the same visible range as the active worksheet for all selected worksheets. It excludes any Chart sheet in the selection and adjusts the zoom of the selected sheets to ensure all worksheets have the same visible area.
Sub SelectedWorksheets_ToSameVisibleRange()
Dim ws As Worksheet
Dim oShs As Object, oSh As Object
Dim sRgAddrs As String
On Error Resume Next
Set ws = ActiveSheet
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Active sheet must be a worksheet type" & String(2, vbLf) _
& String(2, vbTab) & "Process will be cancelled.", _
vbCritical, "Worksheets Common Range View"
Exit Sub
End If
With ActiveWindow
Set oShs = .SelectedSheets
sRgAddrs = .VisibleRange.Address 'Get address of Active Sheet visible range
End With
For Each oSh In oShs
If TypeName(oSh) = "Worksheet" And oSh.Name <> ws.Name Then 'Excludes any chart sheet and the active sheet
With oSh.Range(sRgAddrs)
Application.Goto .Cells, 1 'Activate Worksheet targeted visible range
ActiveWindow.Zoom = True 'Zoom Worksheet to make visible same range as the "active worksheet"
Application.Goto .Cells(1), 1 'Activate 1st cell of the visible range
End With: End If: Next
ws.Select 'Ungroups selected sheets
End Sub
I am having a major issue with my code that is supposed to reset the worksheets, not shut down the entire workbook and force a restart. This has not been an issue, and has only occured since I added the last bit of code starting at On Error Resume Next.
Sub Reset()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Set Up" Or ws.Name = "Report" Then
Else:
Application.DisplayAlerts = False
ws.Delete
End If
Next
Worksheets("Report").Cells.ClearContents
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Charts.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Thanks in advance
If you have chart sheets, then you should use the following code:
Sub DeleteChartSheets()
Dim ch As Chart
For Each ch In ThisWorkbook.Charts
ch.Delete
Next
End Sub
this deletes the charts in a workhseet, say activesheet for example:
Sub DeleteallCharts()
Dim chtObj As ChartObject
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Delete
Next
End Sub
if you want to delete all of the charts in the workbook, then you have to loop through the worksheet too like this:
Sub DeleteallChartsInWorkbook()
Dim chtObj As ChartObject
Dim WS As Worksheet
For Each WS in Thisworkbook.Worksheets
For Each chtObj In WS.ChartObjects
chtObj.Delete
Next chtObj
Next WS
End Sub
I wanted to write a macro which will create AutoFilter, if not present, drop filters and delete specific range in some tabs in my workbook.
I created this code but somehow it doesn't work - data gis deleted only from one tab instead of all that are not listed in If statement. Please help!
Sub ClearTabs()
Dim rng As Range
Dim ws As Worksheet
Set rng = Range("B9:AK100")
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "lastfile" And ws.Name <> "Sheet1" And ws.Name <> "Sheet2" Then
If Not ws.AutoFilterMode Then
ws.Range("B8:AK8").AutoFilter
End If
ws.AutoFilter.ShowAllData
rng.ClearContents
End If
Next ws
End Sub
Following my comment above, You need to set the Range (Set rng = Range("B9:AK100")) inside the For Each ws In ThisWorkbook.Sheets loop.
Code:
Sub ClearTabs()
Dim rng As Range
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
With ws
Select Case .Name
Case "lastfile", "Sheet1", "Sheet2"
' do nothing
Case Else
Set rng = .Range("B9:AK100")
If Not .AutoFilterMode Then
.Range("B8:AK8").AutoFilter
End If
.AutoFilter.ShowAllData
rng.ClearContents
End Select
End With
Next ws
End Sub
you can avoid dimming and setting rng and go like this
Option Explicit
Sub ClearTabs()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
With ws
If .Name <> "lastfile" And .Name <> "Sheet1" And .Name <> "Sheet2" Then
If .AutoFilterMode Then
.AutoFilter.ShowAllData
Else
.Range("B8:AK8").AutoFilter
End If
.Range("B9:AK100").ClearContents
End If
End With
Next
End Sub
I am working with a file where the worksheets have been renamed. Instead of Sheet1(generic name) it is Hoja1(generic name).
Wondering if this is stopping my code from working.
My code is very simple. I dont know what other error I could be having.
Sub Macro1()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Application.DisplaysAlerts = False
If LenB(ActiveSheet.Range("A5")) = "" Then ActiveSheet.Delete
Application.DisplayAlerts = True
Next ws
End Sub
Thank you.
If it's definitely going to have "Hoja" in the sheet name, this should work.
Sub Macro1()
Dim WS As Worksheet
Application.DisplayAlerts = False
For Each WS In ActiveWorkbook.Sheets
If InStr(WS.Name, "Hoja") <> 0 Then WS.Delete
Next
Application.DisplayAlerts = True
End Sub
Got some help from someone.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Application.DisplayAlerts = False
If LenB(ws.Range"A5")) = 0 Then ws.Delete
Application.DisplayAlerts = True
Next ws
The spanish wasn't the issue.
To get the name Hoja1 if the sheet appears as Hoja1(1) in the VBA browser you can use the .CodeName property:
'code borrowed from Alex's answer
Sub Macro1()
Dim WS As Worksheet
Application.DisplayAlerts = False
For Each WS In ActiveWorkbook.Sheets
If InStr(WS.CodeName, "Hoja") <> 0 Then WS.Delete
Next
Application.DisplayAlerts = True
End Sub
What I am trying to do seems basic enough, however I don't know where I am going wrong with the code.
I want to run the selected cell through a loop of the worksheets and select the worksheet that matches the selected cell located in cell B1.
Dim SelectedCell as Range
Dim ws As Worksheet
Set SelectedCell = Range(ActiveCell.Address)
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("B1").Value = SelectedCell.Value Then
ActiveSheet.Select
End If
Next ws
End Sub
Thanks in advance for all the help!
Try instead
Dim ws As Worksheet
SelectedCell = ActiveCell
For Each ws In ActiveWorkbook.Worksheets
If ws.cells(1,2) = SelectedCell Then
ws.Select
End If
Next ws
End Sub
Select cell run macro will select the sheet name that matches the selected cell. (Case sensitive)
Dim SelectCell As String
Dim ws As Worksheet
SelectCell = ActiveCell.Value2
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = SelectCell Then
ws.Select
End ID
Next ws