Announcement

Collapse
No announcement yet.

[Solved] VBA: Coding for freezing panes.

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • [Solved] VBA: Coding for freezing panes.



    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?

  • #2
    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

    Comment


    • #3
      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.

      Comment


      • #4
        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

        Comment


        • #5


          Thanks for the pointers Richie, much appreciated

          Comment

          Working...
          X