[Solved] VBA: Coding for freezing panes.

**damianmcl78** · August 11th, 2003

I am looking for a VBA code solution to the following:

I have a large database, macros run in order to sort the data into manageable chunks.

Whilst the sorting goes on, the user views a 'Please Wait' screen; the screen updating is turned off.

I want to define splits and freeze panes on the pages where data is manipulated. Because the 'please wait' screen is active this is the screen that ends up with the split.

Does anyone have a solution for this predicament?

**Richie(UK)** · August 11th, 2003

Hi Damian,

Would you post the code that you are using?

**damianmcl78** · August 11th, 2003

VB:

Option Explicit 
 
Sub EmailProcess(strLongBuildingName As String, strShortBuildingName As String) 
    ' 
    ' Macro created by Damian McLennan 
    ' Creation Date 29.04.2003 
    ' Version 1.0 - Initial Coding 
    '         1.1 - Optimised Coding - DMcL - 06Aug03 
    ' 
    ' Function: This Is called from the subs In Module4. This macro selects appropriate data For 
    '           the building selected, copies the data To another worksheet, formats data, And 
    '           exports the data As an e-mail attachment. 
    ' 
    ' Reference: Microsoft Outlook 9.0 Object Library 
    ' 
    'First Step - display warning of intended action To user utilising a confirmation messagebox 
     
    Dim Msg As String, Style As String, Title As String, Response As String 
    'set up message box parameters To allow recorded response 
    Msg = "You are about to Email ALL departments in " & strLongBuildingName & _ 
    "." & Chr(13) & "Are you sure you wish to continue?" 
    Style = vbYesNo + vbExclamation 
    Title = "WARNING" 
    Response = MsgBox(Msg, Style, Title) 
    If Response = vbYes Then 
        Goto Start 
    Else 
        Exit Sub 
    End If 
     
    'Begin processing data And creating email Output 
    Start: 
    Worksheets("WORKING").Activate 
    'display 'processing' screen 
     
    Application.ScreenUpdating = False 
    'turn off "screen flicker" 
     
    If Sheets(strShortBuildingName).Range("A2").Value = "" Then Goto NoData 
    'checks To make sure data Is present. If Not quits routine 
     
    Dim strMailcode As String 
    'declaring variable For prefix of mailing address (dependant on network number) 
    If strShortBuildingName = "BRI2" Then strMailcode = "7716-" 
    If strShortBuildingName = "BRO2" Then strMailcode = "7611-" 
    If strShortBuildingName = "CAN2" Then strMailcode = "7615-" 
    If strShortBuildingName = "CEN2" Then strMailcode = "7617-" 
    If strShortBuildingName = "CHA2" Then strMailcode = "7620-" 
    If strShortBuildingName = "COL2" Then strMailcode = "7720-" 
    If strShortBuildingName = "DAL2" Then strMailcode = "7614-" 
    If strShortBuildingName = "H-H2" Then strMailcode = "7405-" 
    If strShortBuildingName = "KEE2" Then strMailcode = "7619-" 
    If strShortBuildingName = "SOU2" Then strMailcode = "7636-" 
    If strShortBuildingName = "SWA2" Then strMailcode = "7717-" 
    If strShortBuildingName = "TRE2" Then strMailcode = "7621-" 
     
    Dim olApp As Outlook.Application 
    'declare variable In preparation For Outlook usage 
    Dim olNewMail As Outlook.MailItem 
    'declare variable In preparation For an email 
    Dim sendTo As String 
    'declare cariable To allow merge of String To create recipient name 
    Dim rngToUse As Range, rngCell As Range 
    'declare variables For looping 
     
    With Worksheets(strShortBuildingName) 
        'begin Loop 
        Set rngToUse = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) 
        'the range from A2 To the last used cell (working up from the end) 
        For Each rngCell In rngToUse 
            'loop through the cells 
            Worksheets("OUTPUT").Unprotect 
            'unlock w/s 
            With Sheets(strLongBuildingName) 
                'select building from which data Is To be sent 
                .Range("V:V").AutoFilter Field:=1, Criteria1:=rngCell 
                'use autofilter To display only entries For particular costcode (rngCell) 
                .Range("A:A,B:B,N:N,O:O,Q:Q,V:V").Copy _ 
                Destination:=Worksheets("OUTPUT").Range("A1") 
                'copy data To Output w/s 
            End With 
             
            With Worksheets("OUTPUT") 
                .Cells.EntireColumn.AutoFit 
                'resize columns 
                With ActiveWindow 
                    'create window split And freeze panes 
                    .SplitColumn = 0 
                    .SplitRow = 1 
                    .FreezePanes = True 
                End With 
                 
                'sort the data by extension number 
                .Range("A:F").Sort Key1:=.Range("D2"), Order1:=xlAscending, Key2:=.Range("A2") _ 
                , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _ 
                False, Orientation:=xlTopToBottom 
                 
                .Rows(1).Insert 
                'insert Row 1 
                'insert message 
                .Range("A1").Value = "Please note, this data refers to the building: " _ 
                & strLongBuildingName 
                .Range("A1:F2").Font.Bold = True 
                'bold Rows 1&2 
                .Range("A3:F150").Font.Bold = False 
                'ensure no other bold 
                .Range("A:H").Locked = False 
                'ensure columns are unlocked 
                .Protect 
                'protect w/s 
                .Copy 
            End With 
            'copy data To New workbook 
            'let us now email the data 
             
             
            Application.DisplayAlerts = False 
            'turn off popup alert boxes 
            ActiveWorkbook.SaveAs FileName:="C:TEMPOUTPUT.XLS", AccessMode:=xlShared 
            'save As a shared workbook - To allow changes To be viewed 
            Application.DisplayAlerts = True 
            'turn on popup alert boxes 
            ActiveWorkbook.Close 
            'close New workbook 
             
            Set olApp = New Outlook.Application 
            'prepare New instance of Outlook 
            Set olNewMail = CreateItem(olMailItem) 
            'prepare To create New mail item 
            sendTo = strMailcode & rngCell 
            'define recipient 
            With olNewMail 
                With .Recipients.Add(sendTo) 
                    'create New email With recipient 
                    .Type = olTo 
                    If Not .Resolve Then 
                        'check If recipient exists In contacts folder 
                        MsgBox "Cannot find recipient: " & sendTo, vbInformation 
                        'recipient does Not exist report To user 
                        LogEvent "Emailing error - cannot find recipient: " & sendTo 
                        'log the error 
                        Goto Name_Error 
                        'continue With Next entry 
                    End If 
                End With 
                .Subject = "Switchboard Directory Updates" 
                'add email subject 
                .Attachments.Add _ 
                "E:Directory Verification Utility Procedures " & _ 
                "PROACTIVE UPDATES - RECIPIENT INSTRUCTIONS.DOC", olByValue, 1, _ 
                "Instructions" 
                'add instruction attachment 
                .Attachments.Add "C:TEMPOUTPUT.XLS", olByValue, 2, sendTo 
                'add data attachment 
                .Body = Chr(11) & Chr(11) & "This E-mail has been sent from xxxxxxx " & _ 
                "Switchboard Services. Please open the Word Document for" _ 
                & "instruction. Thank you." & Chr(13) & Chr(13) & _ 
                "If you have any queries regarding this e-mail, please dial switchboard on" _ 
                & "01xxxxxxxxx and ask for a member of the Directory Update Team." & Chr(13) _ 
                & Chr(13) & "If all details within are correct, no" _ 
                & "response is necessary" 
                .Send 
                'send email 
            End With 
             
            Name_Error: 
             
            Set olNewMail = Nothing 
            'clear Object from memory 
            Set olApp = Nothing 
            'clear Object from memory 
            Kill "C:TEMPOUTPUT.XLS" 
            'delete Output file 
             
        Next 
    End With 
     
    Sheets("START").Activate 
    'select start worksheet 
    MsgBox strLongBuildingName & " Emailing complete", vbInformation 
    'inform user of completion 
    LogEvent "E-mailed " & strLongBuildingName 
    'log completion 
    Application.ScreenUpdating = True 
    'turn on screen flicker 
    Exit Sub 
     
    NoData: 
    MsgBox "There is no data present for " & strLongBuildingName & Chr(13) & _ 
    "Please download database first.", vbCritical 
    Sheets("START").Activate 
    Application.ScreenUpdating = True 
     
End Sub

EDIT : Richie(UK) - edited code to avoid widening of posts on forum.

**Richie(UK)** · August 11th, 2003

Hi Damian,

FreezePanes is applied to the ActiveWindow rather than to a sheet object. You therefore need to make the desired sheet active first then apply the FreezePanes code (I know, I know we are always saying 'You shouldn't use Activate or Select when dealing with objects'. Well this is one of those 'exceptions to the rule'

).

See if the following example helps:

VB:

Sub Macro1() 
    Sheet1.Activate 
    'the starting sheet (Please Wait) 
    Application.ScreenUpdating = False 
    Sheet2.Activate 
    'the sheet To apply FreezePanes To 
    Range("B4").Select 
    ActiveWindow.FreezePanes = True 
    Sheet1.Activate 
    Application.ScreenUpdating = True 
End Sub

HTH

A couple of other points you may like to consider in what looks like some pretty impressive code overall.

1. The initial messagebox response could probably be shortened to avoid the Goto. Eg

VB: