Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / 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
    Code:
    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:
    Code:
    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
    Code:
    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 1 users browsing this thread. (0 members and 1 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, 22:33
  2. [Solved] Printing: Freeze Panes & Print
    By Ted in forum EXCEL HELP
    Replies: 2
    Last Post: July 22nd, 2003, 05:04
  3. Freezing Panes
    By Sue Heswall in forum EXCEL HELP
    Replies: 8
    Last Post: July 18th, 2003, 23:09
  4. [Solved] VBA: Freezing panes
    By Nidetzg in forum EXCEL HELP
    Replies: 1
    Last Post: July 12th, 2003, 02: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