Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / Excel Dashboards Reports



Results 1 to 5 of 5

Thread: [Solved] VBA: Coding for freezing panes.

  1. #1
    Join Date
    11th April 2003
    Location
    South Scotland
    Posts
    120
    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?

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    25th January 2003
    Location
    UK
    Posts
    2,745
    Hi Damian,

    Would you post the code that you are using?
    Cross-poster? Read this: Cross-posters
    Struggling to use tags (including Code tags)? : Forum tags

  3. #3
    Join Date
    11th April 2003
    Location
    South Scotland
    Posts
    120
    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.

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    25th January 2003
    Location
    UK
    Posts
    2,745
    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:
    If Response = vbNo Then Exit Sub 
    
    
    2. The multiple If statements re 'strShortBuildingName' would run faster is used in a Select Case construct.

    HTH too
    Cross-poster? Read this: Cross-posters
    Struggling to use tags (including Code tags)? : Forum tags

  5. #5
    Join Date
    11th April 2003
    Location
    South Scotland
    Posts
    120
    Thanks for the pointers Richie, much appreciated

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 2 users browsing this thread. (0 members and 2 guests)

Possible Answers

  1. [Solved] Charts: Freezing columns & rows at the same tim
    By lordvoldemort in forum EXCEL HELP
    Replies: 2
    Last Post: September 8th, 2003, 21:33
  2. [Solved] Printing: Freeze Panes & Print
    By Ted in forum EXCEL HELP
    Replies: 2
    Last Post: July 22nd, 2003, 04:04
  3. Freezing Panes
    By Sue Heswall in forum EXCEL HELP
    Replies: 8
    Last Post: July 18th, 2003, 22:09
  4. [Solved] VBA: Freezing panes
    By Nidetzg in forum EXCEL HELP
    Replies: 1
    Last Post: July 12th, 2003, 01:23

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno