View Full Version : Skip first sheet in For Each loop?
whatsapro
06-09-2016, 07:00 AM
I was trying to freeze the first row of each sheet besides the first sheet. Can someone help me find a way to skip the first sheet in this loop?
Public Sub FreezePanes()
Dim s As Worksheet
Dim c As Worksheet
'// store current sheet
Set c = ActiveSheet
'// Stop flickering...
Application.ScreenUpdating = False
'// Loop throught the sheets
For Each s In ThisWorkbook.Worksheets
'// Have to activate - SplitColumn and SplitRow are properties
'// of ActiveSheet
s.Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
Next
'// Back to original sheet
c.Activate
Application.ScreenUpdating = True
Set s = Nothing
Set c = Nothing
End Sub
Paul_Hossler
06-09-2016, 07:18 AM
Try something like this
'If Not s Is c Then' checks to see if s and c are not the same object
BTW, 'First' sheet might not be the same as 'ActiveSheet'
Option Explicit
Public Sub FreezePanes()
Dim s As Worksheet
Dim c As Worksheet
'// store current sheet
Set c = ActiveSheet
'// Stop flickering...
Application.ScreenUpdating = False
'// Loop throught the sheets
For Each s In ThisWorkbook.Worksheets
If Not s Is c Then '<<<<<<<<<<<<<<<<<<<<
'// Have to activate - SplitColumn and SplitRow are properties
'// of ActiveSheet
s.Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
End If '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Next
'// Back to original sheet
c.Select '<<<<<<<<<<<<<<
Application.ScreenUpdating = True
Set s = Nothing
Set c = Nothing
End Sub
whatsapro
06-09-2016, 09:27 AM
That worked. Thank you.
Now I have a new issue. When I create new sheets via another Sub function, how do I make sure this is applied automatically? Any suggestions?
I also really appreciate the help. I am learning bits and pieces as I string these things together but I am by far still very ignorant on VBA.
Here is what I have.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cwkb As Workbook
Set cwkb = ThisWorkbook
'Dim wkb As Workbook
Dim mySel As Range, aCell As Range
Dim folderPath As String
Dim LR As Long
folderPath = Application.ActiveWorkbook.Path
If Not Intersect(Range("O2:O400"), Target) Is Nothing Then
If WorksheetFunction.IsError(Target.Value) Then
ElseIf Target.Value <> "" Then
Dim ws As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Left(Target.Value, Len(Target.Value) - 1)
'Set wkb = Workbooks.Open(folderPath & "\DLA Supportability_Report 5-6-16 improved")
With cwkb.Sheets(2)
.AutoFilterMode = False
.Range("A1:Y1").AutoFilter
.Range("A1:Y1").AutoFilter Field:=1, Criteria1:=Left(Target.Value, Len(Target.Value) - 1)
End With
'~~> Change this to the relevant sheet
'Set ws = wkb.Sheets(1)
'~~> Change this to the relevant range
' Set mySel = wkb.Sheets(1).Range("I1:U1000")
For Each aCell In cwkb.Sheets(2).AutoFilter.Range.Cells
With aCell
.Interior.Color = .DisplayFormat.Interior.Color
End With
Next aCell
'
'~~> Now Do the copying
'
'~~> Once you are done, close the sorce worksheet without saving
cwkb.Sheets(2).AutoFilter.Range.Copy
cwkb.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Paste
cwkb.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Cells.EntireColumn.AutoFit
Application.DisplayAlerts = False
'wkb.Close SaveChanges:=False
End If
End If
End Sub
Public Sub FreezePanes()
Dim s As Worksheet
Dim c As Worksheet
'// store current sheet
Set c = ActiveSheet
'// Stop flickering...
Application.ScreenUpdating = False
'// Loop throught the sheets
For Each s In ThisWorkbook.Worksheets
If Not s Is c Then '<<<<<<<<<<<<<<<<<<<<
'// Have to activate - SplitColumn and SplitRow are properties
'// of ActiveSheet
s.Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
End If '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Next
'// Back to original sheet
c.Select '<<<<<<<<<<<<<<
Application.ScreenUpdating = True
Set s = Nothing
Set c = Nothing
End Sub
When I create a new sheet via double clicking on a cell, how can I make the freeze pane part of the new sheet dynamically?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cwks As WorkSheet '<<<<<<<<<<<<<<<<<<
Dim ws As Worksheet
Dim ShName As String
Dim aCell As Range
Dim folderPath As String
If Intersect(Range("O2:O400"), Target) Is Nothing Then Exit Sub
If WorksheetFunction.IsError(Target.Value) Then Exit Sub
If Target.Value = "" Then Exit Sub
'Uncomment below after testing
With Application
'.DisplayAlerts = False
'.ScreenUpdating = False
End With
Cancel = True 'This sub will do all the work needed
With ThisWorkbook
Set cwks = .Sheets(2)
folderPath = .Path
ShName = Left(Target.Value, Len(Target.Value) - 1)
On Error Resume Next
.Sheets(ShName).Delete
On Error GoTo 0
Set ws = .Sheets.Add(After:= .Sheets(.Sheets.Count))
End With
With cwks
.AutoFilterMode = False
.Range("A1:Y1").AutoFilter
.Range("A1:Y1").AutoFilter Field:=1, Criteria1:=ShName)
.AutoFilter.Range.Interior.Color = .DisplayFormat.Interior.Color
.AutoFilter.Range.Copy
End With 'sheets(2)
With ws
.Name = ShName
.Paste
.Cells.EntireColumn.AutoFit
.activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With 'Active Window
End With 'New Sheet
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.