asked on

VBA: freeze panes and bold rows through a procedure

Hello experts, I have the following procedure which allows me to freeze panes based on 4 parameters:

1-String sheet name to apply an specific freeze pane
2-SheetName if I want to select this specific sheet after the procedure is done
3-Rws1 related to this freeze panes
4-Rws2 freeze pane if condition 1 is false

What i want to add is to bold the various rows which are above the freeze pane:

Sub FreezePane(SheetNameString As String, SheetName As String, Rws1 As String, Rws2 As String)

    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws1).Select
            ActiveWindow.FreezePanes = True
        Else
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Select
            ActiveWindow.FreezePanes = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select
End Sub

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub

Open in new window

Based on RunFreezePane I freeze pane in row 4 if I a Sheet name contains "GAP" in that case I should bold rows 1, 2 and 3 else I freeze in row 2 so I should bold row 1.

Thank you very much for your help.

ste5an

Start the macro recorder, then you'll get the necessary commands in Module1 recorded.

Roy Cox

Try this amended code

Option Explicit

Sub FreezePane(SheetNameString As String, SheetName As String, Rws1 As String, Rws2 As String)

    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws1).Select
            ws.Rows("1:3").Font.Bold = True
            ActiveWindow.FreezePanes = True
        Else
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Select
            ws.Rows("1:1").Font.Bold = True
            ActiveWindow.FreezePanes = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select
End Sub

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub

Open in new window

Luis Diaz

ASKER

Thank you! Is not a way to parse the modified rows as parameter and not as static rows? And if possible is not a way to dynamically take as reference rws1 and rws2 and make an offset and bold the required rows?

Roy Cox

You don't need to, the original code fixes the freezepanes at Row 2 or Row 3 so you have a fixed range for each option.

Roy Cox

If you wanted to maybe something like this

Option Explicit

Sub FreezePane(SheetNameString As String, SheetName As String, Rws As String, Rws2 As String)

    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws).Select
            ws.Rows(Rws).Offset(-3).Resize(3).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
        Else
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Select
            ws.Rows(Rws2).Offset(-1).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select
End Sub

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub

Open in new window

Luis Diaz

ASKER

Thank you for your comment.

The idea is to call the procedure and to adapt dynamically the bold process.

If I call Example 2 it will not work

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub

By

'############ Example2'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "5:5", "3:3"
End Sub

In example2 I will not bold the required rows as I should bold 1:4 and 1:2 and not the fixed rows already defined in the procedure

Roy Cox

Removing the selection of the rows would speed it up slightly

Option Explicit

Sub FreezePane(SheetNameString As String, SheetName As String, Rws As String, Rws2 As String)

    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws).Offset(-3).Resize(3).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
        Else
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Offset(-1).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select
End Sub

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub

Open in new window

Roy Cox

EDit: missed your previous post. Let me know if this works

Maybe you want to change the Rws and Rws2 so try this

Option Explicit

Sub FreezePane(SheetNameString As String, SheetName As String, Rws As String, Rws2 As String)

    Dim ws As Worksheet
Dim iX As Integer
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            iX = CInt(Mid(Rws, 1, 1))
            ws.Rows(Rws).Offset(-(iX - 1)).Resize(iX - 1).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
        Else
            ws.Activate
            iX = CInt(Mid(Rws2, 1, 1))
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Offset(-(iX - 1)).EntireRow.Font.Bold = True
            ActiveWindow.FreezePanes = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select
End Sub

'############ Example'############
Sub RunFreezePane()
FreezePane "Gap", ActiveSheet.Name, "5:5", "3:3"
End Sub

Open in new window

Luis Diaz

ASKER

Sorry for the delay.
I tested your previous code but I have some problems with the freeze actions (for Gap Sheet, I have an unwanted offset of my columns).
So I decided to distinguish the freeze and the bold actions as follows and it works properly:

Sub FreezePane(SheetNameString As String, SheetName As String, Rws1 As String, Rws2 As String)

    Dim ws As Worksheet
    Dim iX As Integer
    
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
       If ws.Name Like "*" & SheetNameString & "*" Then
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws1).Select
            ActiveWindow.FreezePanes = True
            iX = CInt(Mid(Rws1, 1, 1))
            ws.Rows(Rws1).Offset(-(iX - 1)).Resize(iX - 1).EntireRow.Font.Bold = True
        Else
            ws.Activate
            ActiveWindow.FreezePanes = False
            ws.Rows(Rws2).Select
            ActiveWindow.FreezePanes = True
            iX = CInt(Mid(Rws2, 1, 1))
            ws.Rows(Rws2).Offset(-(iX - 1)).Resize(iX - 1).EntireRow.Font.Bold = True
            
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Worksheets(SheetName).Select

Sub RunFreezePane2()
FreezePane2 "Gap", ActiveSheet.Name, "4:4", "2:2"
End Sub
End Sub

Open in new window

If you have an idea why is not working your previous version you can send me a revised code otherwise I will accept your previous code as a solution as it helps to get my final result.

Thank you again for your help.

ASKER CERTIFIED SOLUTION

Roy Cox

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Thank you for this file.

I tested again by changing the rows and I don't know why I get the right result in GapA sheet but a wrong result in Gap2 and Gap. Sheet1 result is fine.

Thank you very much for your help.
FreezePanes_2.xlsm

Roy Cox

If I change Rw1 to "6:6" the all 3 sheets with Gap in the name are frozen at Row5

Luis Diaz

ASKER

Yes you are right the freeze action works perfectly. The problem is the bold. I think that the string contains gap is not working properly.
Please see my snapshots.
GapA bold the rows properly from 1 to 5.
Gap and Gap2 bold the rows from 1 to 6 and it should just bold from 1 to 5.

Thank you again for your help.
2015-09-06-21_02_20-Microsoft-Excel-.png
2015-09-06-21_02_34-Microsoft-Excel-.png
2015-09-06-21_02_54-Microsoft-Excel-.png

Roy Cox

Are you clearing bold formats from previous tests? The code works perfectly for me

Luis Diaz

ASKER

Yes, I have cleared the various sheets. Overall the code works that is the most important.

Roy Cox

I don't understand why you are getting extra bold rows. My dummy workbook doesn't,