Would you post the code that you are using?
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?
EDIT : Richie(UK) - edited code to avoid widening of posts on forum.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
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:HTHVB: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
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. Eg2. The multiple If statements re 'strShortBuildingName' would run faster is used in a Select Case construct.VB:If Response = vbNo Then Exit Sub
There are currently 2 users browsing this thread. (0 members and 2 guests)