PDA

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?

SamT
06-09-2016, 12:18 PM
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