How to Add Filter and Freeze Pane

[sgmpatnaik]

Respected Sir's,


i have small doubt in write the VBA Code for ADD the Filter and Freeze option


Sir,


I created one code for to insert the new Sheet based with existing Sheet, with the code i got success but there is one problem that is i would like to add the filter and Freeze option to newly inserted sheet but i can't


So kindly suggest me with that code, the code is given below:


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim isect As Range

Dim n As Integer

Dim SheetExists As Boolean

If Target.Cells.Count > 1 Then Exit Sub


On Error GoTo ResetApplication

Application.EnableEvents = False


Set isect = Intersect(Target, Range("B:B"))


If Not isect Is Nothing And Target <> "" Then

For n = 1 To Sheets.Count

If Sheets(n).Name = Target Then

SheetExists = True

Exit For

End If

Next

If Not SheetExists Then

ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)


ActiveSheet.Name = Target


Me.Activate

Target.Select

Sheets("Party Sheet").Unprotect Password:="password" 'replase password with actual password

Sheets("Party Sheet").Range("A:Z").Copy Sheets(Target.Value).Range("A1")

Sheets("Party Sheet").Protect Password:="password" 'replase password with actual password


With Sheets(Target.Value)

.Range("B2").Value = .Name

End With

Sheets(Target.Value).Activate

Sheets(Target.Value).Protect Password:="password" 'replase password with actual password

End If

End If


ResetApplication:

Err.Clear

On Error GoTo 0

Application.EnableEvents = True

Set isect = Nothing


End Sub


With The above code i success to create a new sheet but i want to add the Filter the Freeze option so i set the code like this


With Sheets(Target.Value)

.Range("B2").Value = .Name

End With

Sheets(Target.Value).Activate

Range("A5:O5").AutoFilter

Range("B6:E17").Select

ActiveWindow FreezePanes = True

Range("D12").Select

ActiveWindow.SmallScroll Down:=-15

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFormattingCells:=True, AllowFormattingColumns:=True, _

AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowFiltering _

:=True, AllowUsingPivotTables:=True

Sheets(Target.Value).Protect Password:="password" 'replase password with actual password

End If

End If


But i am not success kindly suggest me sir


Hence i oblige


With Regards


SP

 

[kaushik03]

Hi SP,


If your requirement is to 'ON' autofilter and freeze the pane, the following two line should do the job..


For filter:

Range("your range goes here").AutoFilter


To freeze pane

ActiveWindow.FreezePanes = True......(this will freeze top row and left column)


Without looking at your sheet I am not able to understand what is going wrong.


Can u plz upload your workbook?


Kaushik

 

[NARAYANK991]

Hi Patnaik ,


This statement from your code appears to be a problem :

[pre]

ActiveWindow FreezePanes = True

[/pre]
Narayan

 

[sgmpatnaik]

Thank Q Narayank991 Sir,


i just changed my code and it's working the code is given below


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim isect As Range

Dim n As Integer

Dim SheetExists As Boolean

If Target.Cells.Count > 1 Then Exit Sub


On Error GoTo ResetApplication

Application.EnableEvents = False


Set isect = Intersect(Target, Range("B:B"))


If Not isect Is Nothing And Target <> "" Then

For n = 1 To Sheets.Count

If Sheets(n).Name = Target Then

SheetExists = True

Exit For

End If

Next

If Not SheetExists Then

ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)


ActiveSheet.Name = Target


Me.Activate

Target.Select

Sheets("Party Sheet").Unprotect Password:="password" 'replase password with actual password

Sheets("Party Sheet").Range("A:Z").Copy Sheets(Target.Value).Range("A1")

Sheets("Party Sheet").Protect Password:="password" 'replase password with actual password


Sheets(Target.Value).Activate

ActiveSheet.Range("B2").Value = ActiveSheet.Name

ActiveSheet.Range("A5:O5").AutoFilter

ActiveSheet.Range("B6:E17").Select

ActiveWindow.FreezePanes = True

ActiveSheet.Range("D12").Select

ActiveWindow.SmallScroll Down:=-15

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFormattingCells:=True, AllowFormattingColumns:=True, _

AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowFiltering _

:=True, AllowUsingPivotTables:=True, Password:="password" 'replace password with actual password

End If

End If


ResetApplication:

Err.Clear

On Error GoTo 0

Application.EnableEvents = True

Set isect = Nothing


End Sub