The blinking is driving me crazy

billbrunt

Board Regular
Joined
Jul 17, 2009
Messages
178
Hi -

I've posted this a few times, but so far, no one has cracked this. I have a large workbook (I'm actually not going to say how many worksheets but lets leave it at 3 digits). Its a cool application, works well except for one thing, at least that I know of. When I open it, it runs the workbook_open code and sometimes the Excel entry in status bar just blinks. I can click around a bit, i.e. I can open Visual Basic, open modules, select text but I can't copy it. Nor can I use the worksheets. It does show a macro as running but I try Ctrl-Break, Ctrl-C and lots of other stuff to no avail.

My "solution" is to copy the workbook to a non-trusted location and open it so the macros don't run. Then, I click to enable this content and it runs and all is good. Other times, I open the workbook and the macros run and then it works fine. I have yet to find a pattern.

I've been asked in the past to post the code, so, here goes....

Code:
Private Sub Workbook_Open()
    On Error GoTo ErrHandler1:
    
    Dim ErrorTrapped As String
    Dim MSEnvironmentVariable As String
    Dim SizeOfHelpFile As Long
    Dim svThisVersionStr As String
    Dim svMostCurrentVersionStr As String
    Dim svThisVersion As Long
    Dim svMostCurrentVersion As Long
    
    wsAbout.Select ' This worksheet is selected first so that the release notes section is forced to come up when the user
                   ' navigates away from this page. Couldn't call help directly from this subroutine as it went into an
                   ' infinite loop.
    
    ThisWorkbook.SheetPushedOntoStack = "wsAbout"
    
    pvDebugModeOn = False
    
    If pvDebugModeOn Then
            svStyle = vbOKOnly
            svErrorNo = 0
            svTitle = "MONEYSCIENCE Error Message # " & svErrorNo
            svErrorMessage = "This is a debug message and should not have displayed." & vbNewLine & vbNewLine & _
                        "*** You can proceed and ignore this. ***" & vbNewLine & _
                        "Let support know via the help topic Obtaining support" & vbNewLine & vbNewLine
            subDisplayError svTitle, svErrorMessage, svStyle, True, svErrorNo, False
    End If
    '
    ' Check the setup of wsPrintAreaConfiguration for worksheet definitions
    '
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    subErrorCheckWorksheetListing
    '
    ' Make sure Workbook applications are set correctly.
    '
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ActivateSheetValveControlProcessing = False
    Application.MoveAfterReturnDirection = xlToRight
    
    '
    ' Global Variables
    '
    SizeOfHelpFile = 351989
    pvPasswordForProtection = "Money"
    SupportContactName = "Bill Brunt"
    gblvarSupportContactEmail = "[EMAIL="billbrunt@usa.net"]billbrunt@usa.net[/EMAIL]"
    SupportContactPhone = "201-663-1770"
    '
    '
    '
    ErrorTrapped = "No"
    MSEnvironmentVariable = Environ("MS")
    '
    ' Set a default worksheet to go back to if there are errors in wsLifeInsIllustratorSimulator
    '
    If ActiveSheet.Name <> "Life Ins Illustrator Simulator" Then
        ThisWorkbook.SheetPushedOntoStack = ActiveSheet.Name
    Else
        ThisWorkbook.SheetPushedOntoStack = wsFDPXLIllustration1.Name
    End If
    '
    ' See if the environment variable %MS% exists or is empty.
    '
    If MSEnvironmentVariable = "" Then
        Style = vbOKOnly                                                                    ' Define buttons.
        Title = "MoneyScience Error Message #10"
        ErrorMessage = "The environment variable %MS% is NULL and not set." & vbNewLine & _
                    "Some features such as help and automatically loading" & vbNewLine & _
                    "FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
                    "" & vbNewLine & _
                    "To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
                    "MONEYSCIENCE LifeProfiler is installed  and then restart Excel." & vbNewLine & _
                    vbNewLine & _
                    "For assistance contact: " & vbNewLine & _
                    "" & vbNewLine & _
                    "                 " & SupportContactName & vbNewLine & _
                    "                 " & gblvarSupportContactEmail & vbNewLine & _
                    "                 " & SupportContactPhone & vbNewLine
        Response = MsgBox(ErrorMessage, Style, Title)
        ErrorTrapped = "Yes"
    End If
    '
    ' Check to see if the environment variable %MS% is a valid path or file.
    '
    If GetAttr(MSEnvironmentVariable) <> 16 Then
    End If
    '
    ' Check that the environment variable %MS% is set to a valid path assuming the environment variable
    ' points to a file or directory which exists.
    '
    If ErrorTrapped = "No" Then
        If GetAttr(MSEnvironmentVariable) And vbDirectory <> 16 Then
            Style = vbOKOnly                                                                    ' Define buttons.
            Title = "MoneyScience Error Message #10"
            ErrorMessage = "The environment variable %MS% is set to something other than a valid directory." & vbNewLine & _
                        "Some features such as help and automatically loading" & vbNewLine & _
                        "FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
                        "" & vbNewLine & _
                        "The environment variable %MS% is set to: " & MSEnvironmentVariable & vbNewLine & _
                        "" & vbNewLine & _
                        "To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
                        "MONEYSCIENCE LifeProfiler is installed  and then restart Excel." & vbNewLine & _
                        "Currently, it is pointing to something other than a directory." & vbNewLine & _
                        vbNewLine & _
                        "For assistance contact: " & vbNewLine & _
                        "" & vbNewLine & _
                        "                 " & SupportContactName & vbNewLine & _
                        "                 " & gblvarSupportContactEmail & vbNewLine & _
                        "                 " & SupportContactPhone & vbNewLine
            Response = MsgBox(ErrorMessage, Style, Title)
            ErrorTrapped = "Yes"
        End If
    End If
    '
    ' Ensure that the workbook running is the one in the directory  contained in the environment variable %MS%
    '
    If ErrorTrapped = "No" Then
        If ActiveWorkbook.Path & "\" & ActiveWorkbook.Name <> MSEnvironmentVariable & "\" & ActiveWorkbook.Name Then
            Style = vbOKOnly                                                                    ' Define buttons.
            Title = "MoneyScience Error Message #12"
            ErrorMessage = "The %MS% environment is set to a location containing a workbook of this name but you're not running" & vbNewLine & _
                        "the workbook in %MS%." & vbNewLine & vbNewLine & _
                        "The location you're running from is: " & ActiveWorkbook.Path & vbNewLine & _
                        "The location of %MS% is: " & Environ("MS") & vbNewLine & vbNewLine & _
                        "To fix this, either change the value of %MS% to this location or move this workbook to" & vbNewLine & _
                        "the directory specified by the environment variable %MS%." & vbNewLine & _
                        vbNewLine & _
                        "For assistance contact: " & vbNewLine & _
                        "" & vbNewLine & _
                        "                 " & SupportContactName & vbNewLine & _
                        "                 " & gblvarSupportContactEmail & vbNewLine & _
                        "                 " & SupportContactPhone & vbNewLine
            Response = MsgBox(ErrorMessage, Style, Title)
            ErrorTrapped = "Yes"
        End If
    End If
    
    On Error GoTo ErrHandler2:
    
    If FileLen(Environ("MS") + "\helpfiles\MoneyScience.chm") <> SizeOfHelpFile Then
        If ErrorTrapped <> "Yes" Then
            Style = vbOKOnly                                                                    ' Define buttons.
            Title = "MoneyScience Error Message #16"
            ErrorMessage = "You don't have the most recent help file loaded in the correct location." & vbNewLine & _
                        "The helpfile " & Environ("MS") & "\helpfiles\MoneyScience.chm" & vbNewLine & _
                        "is " & Format(FileLen(Environ("MS") + "\helpfiles\MoneyScience.chm"), "#,##0") & " bytes in size " & _
                        "and should be " & Format(SizeOfHelpFile, "#,##0") & " bytes in size." & vbNewLine & _
                        vbNewLine & _
                        "For assistance contact: " & vbNewLine & _
                        "" & vbNewLine & _
                        "                 " & SupportContactName & vbNewLine & _
                        "                 " & gblvarSupportContactEmail & vbNewLine & _
                        "                 " & SupportContactPhone & vbNewLine
            Response = MsgBox(ErrorMessage, Style, Title)
            ErrorTrapped = "Yes"
        End If
    End If
'' Don't uncomment the next 3 lines as the dynamic ribbon control interferes and it is an endless loop.
''    If wsVariables.Range("Start_Help_When_Starting_Software").Value = "Yes" Then
''        CallsToHelp 13
''    End If
    '
    ' Check the version number of this workbook against the most recent version out on the web and
    ' report to the user how this version compares to most recent web version.
    ' If the most recent web version value is different than what is in the range "MostCurrentVersion"
    ' then update the range MostCurrentVersion with the value from the web.
    '
    svThisVersionStr = wsAbout.Range("This_Version")
    
    subGetCurrentVersionFromTheWeb
    
    svThisVersion = Mid(svThisVersionStr, 1, 1) * 1000000 + _
                        Mid(svThisVersionStr, 3, 1) * 100000 + _
                        Mid(svThisVersionStr, 5, 1) * 10000 + _
                        Mid(svThisVersionStr, 7, 4)
 
    svMostCurrentVersion = Mid(pvLifeProfilerVersion, 1, 1) * 1000000 + _
                        Mid(pvLifeProfilerVersion, 3, 1) * 100000 + _
                        Mid(pvLifeProfilerVersion, 5, 1) * 10000 + _
                        Mid(pvLifeProfilerVersion, 7, 4)
    If svThisVersion < svMostCurrentVersion Then
        MsgBox ("There is a newer version available on the web" & vbNewLine & _
                "See the help topic Getting the Most Recent Version" & vbNewLine & _
                "for more details on how to do.")
    End If
    If svThisVersion > svMostCurrentVersion Then
        MsgBox ("You are running a version which is higher than the" & vbNewLine & _
                "currently released version. Please notify support." & vbNewLine & vbNewLine & _
                "Please see the help topic " & """" & "Obtaining Support" & """")
    End If

    If RTrim(pvLifeProfilerVersion) <> RTrim(Range("MostCurrentVersion").Value) Then
        If wsAbout.Range("rnDeveloperOrUserMode").Value = "User" Then
            wsAbout.Unprotect "Money"
            Range("MostCurrentVersion").Value = pvLifeProfilerVersion
            wsAbout.Protect "Money"
        End If
    End If
    
    If wsAbout.Range("rnDeveloperOrUserMode") = "Developer" Then
        subShowDeveloperMenu
    End If
    
    
    
    Exit Sub
    
ErrHandler1:
    If Err.Number = 53 And ErrorTrapped = "No" Then
        Style = vbOKOnly                                                                    ' Define buttons.
        Title = "MoneyScience Error Message #11"
        ErrorMessage = "The environment variable %MS% is set to path which doesn't exist." & vbNewLine & _
                    "" & vbNewLine & _
                    "Some features such as help and automatically loading" & vbNewLine & _
                    "FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
                    "" & vbNewLine & _
                    "The value of %MS% is: " & MSEnvironmentVariable & vbNewLine & _
                    "This workbook is called: " & ActiveWorkbook.Name & vbNewLine & _
                    "and is located in: " & ActiveWorkbook.Path & vbNewLine & _
                    "" & vbNewLine & _
                    "To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
                    "MONEYSCIENCE LifeProfiler is installed  and then restart Excel." & vbNewLine & _
                    "If the path and %MS% variable appear correct, don't forget to restart Excel." & vbNewLine & _
                    vbNewLine & _
                    "For assistance contact: " & vbNewLine & _
                    "" & vbNewLine & _
                    "                 " & SupportContactName & vbNewLine & _
                    "                 " & gblvarSupportContactEmail & vbNewLine & _
                    "                 " & SupportContactPhone & vbNewLine
        Response = MsgBox(ErrorMessage, Style, Title)
        ErrorTrapped = "Yes"
    End If
    
    If ErrorTrapped <> "Yes" Then
        MsgBox (Err.Number & " " & Err.Description)
    End If
    Resume Next
ErrHandler2:
    If Err.Number = 53 And ErrorTrapped = "No" Then
        Style = vbOKOnly                                                                    ' Define buttons.
        Title = "MoneyScience Error Message #15"
        ErrorMessage = "The help file is not present." & vbNewLine & _
                    "" & vbNewLine & _
                    "There should be a file called MoneyScience.chm in a subdirectory called \helpfiles" & vbNewLine & _
                    "off the directory listed in the environment variable %MS% and it is not there." & vbNewLine & _
                    "" & vbNewLine & _
                    "The value of %MS% is: " & MSEnvironmentVariable & vbNewLine & _
                    "" & vbNewLine & _
                    "For assistance contact: " & vbNewLine & _
                    "" & vbNewLine & _
                    "                 " & SupportContactName & vbNewLine & _
                    "                 " & gblvarSupportContactEmail & vbNewLine & _
                    "                 " & SupportContactPhone & vbNewLine
        Response = MsgBox(ErrorMessage, Style, Title)
        ErrorTrapped = "Yes"
    End If
    If ErrorTrapped <> "Yes" Then
        MsgBox (Err.Number & " " & Err.Description)
    End If
    Resume Next
    
End Sub

Sub subErrorCheckWorksheetListing()
' Written by:   Bill Brunt
' Date:         8/21/2009
' Purpose:      This routine should be called from routines where events have been disabled, display is off as is calcuation.
'               To check the worksheet listing contained in the wsPrintAreaConfiguration worksheet against those which exist
'               and provide error checking to ensure that printing and other operations will perform as expected.
'               This routine will run when the workbook opens and closes to ensure the list is maintained
'               and error free. It will test that:
'               1) All existing worksheets in the workbook are listed in worksheets section of wsPrintAreaConfiguration.
'               2) All worksheets listed in the worksheets section of wsPrintAreaConfiguration exist as worksheets
'               3) The list is sorted by MoneyScience Worksheet Type and then Order Within Worksheet type and the SheetID are all
'                  in ascending order.
'               4) There is a Yes or No Value in "Hide For User Mode"
'               5) There is a value in the column MoneyScience Worksheet Type which exists in the range List_MoneyScience_Worksheet_Type
'               6) The column Order within Worksheet Type contains ascending values starting at 1 for each MoneyScience Worksheet Type
'               7) In the User has chosen to Print column, all rows contain either Yes or No.
'               8) Print Area should contain a valid range unless Hide for User Mode = "Yes" or Print Area is Variable = "Yes"
'               9) "Print Area is Variable" should contain "Yes" or "No" and also that there is a valid range in "Variable Print Area
'                  including first row" when "Print Area is Variable" is "Yes".
'              10) Ensure that the value in "Column for Tag Headings" is a valid column
'              11) Ensure that only "Hide For User Mode" = "Yes" have "-" in "Column for Tag Headings".
'              12) Ensure that "Column for Tag Headings" is within the defined print range
'              13) Check to see the column "Offset for Max Value" is within the defined print range.
'              14) See if it is a valid row range for the rows to repeat at thet top.
'              15) See that each entry in "Columns to Hide for Printing" is a Valid Column
'              16) Test for the Right Footer = "-" or it being unique.
'              17) Make sure the variable print area covers the used region.
'
' Modified:     Who/Date/What
'
' Load all worksheets and their Index into an array
'
    Dim svi As Integer
    Dim svj As Integer
    Dim svWorksheetsExisting(200, 4)
    Dim svMONEYSCIENCEWorksheetType(100)
    Dim svColumn As Long
    Dim svStartingRow As Long
    Dim svEndingRow As Long
    Dim svColumn2 As Long
    Dim svStartingRow2 As Long
    Dim svEndingRow2 As Long
    Dim svCurrentUserWorksheet As String
    Dim svsomevar As String
    Dim svtempvar As String
    Dim svtempcol As String
    Dim svtemprow As Integer
    Dim svVariablePrintAreaStartingColumn As Integer
    Dim svVariablePrintAreaTotalColumns As Integer
    Dim svCurrentRegionStartingColumn As Integer
    Dim svCurrrentRegionTotalColumns As Integer
    
    
    
    Dim svEndingAddress As String
    Dim svStartingAddress As String
    Dim svEndingAddress2 As String
    Dim svStartingAddress2 As String
    Dim svExistsInwsPrintAreaConfiguration As Boolean
    Dim svExistsInWorksheets As Boolean
    Dim svValidWorksheetType As Boolean
    
    Dim rgWorkSheetNames As Range
    Dim rgIncludeInPrinting As Range
    Dim rgSheetsToPrintListing As Range
    
    Dim svApplicationCalculation As Long
    Dim svApplicationScreenUpdating As Boolean
    Dim svApplicationEnableEvents As Boolean
    
    Dim svErrorNo As Integer
    Dim svErrorMessage As String
    Dim svColumnsToHideForPrinting As String
    Dim svColumnToHide As String
    Dim svCommaIsAt As Integer
    
    Dim svWorksheetIndex(200) As Integer
    Dim svWorksheetName(200) As String
    Dim svWorksheetCodeName(200) As String
    Dim svWorksheetHideForUserMode(200) As String
    Dim svWorksheetMoneyScienceWorksheetType(200) As String
    Dim svWorksheetOrderWithinWorksheetType(200) As Double
    Dim svWorksheetUserHasChoosenToPrint(200) As String
    Dim svWorksheetPrintArea(200) As String
    Dim svWorksheetPrintAreaIsVariable(200) As String
    Dim svWorksheetVariablePrintArea(200) As String
    Dim svWorksheetColumnforTagHeadings(200) As String
    Dim svWorksheetOffsetforMaxValue(200) As Integer
    Dim svWorksheetRowsToRepeatAtTop(200) As String
    Dim svWorksheetColumnsToHideForPrinting(200) As String
    Dim svWorksheetRightFooter(200) As String
    Dim svWorksheetFitPagesToTall(200) As String
    Dim svWorksheetUniqueRightFooters(200) As String
    Dim svWorksheetUniqueRightFootersCount(200) As Integer
    Dim svVariablePrintAreaDef As String
    Dim svCurrentRegion As String
    
    Dim svWorksheetTotalUniqueRightFootersCount As Integer
    
    Dim svWorksheetErrorFlag(200) As String
    
    Dim svSheetsToPrintProtectContents As Boolean
    
    svApplicationCalculation = Application.Calculation
    svApplicationScreenUpdating = Application.ScreenUpdating
    svApplicationEnableEvents = Application.EnableEvents
    
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    '
    ' Load the array of worksheets
    '
    For svi = 1 To Worksheets.Count
        svWorksheetsExisting(svi, 1) = svi
        svWorksheetsExisting(svi, 2) = Worksheets(svi).Name
        svWorksheetsExisting(svi, 3) = Worksheets(svi).CodeName
    Next svi
    '
    ' Clear the index and put new formulas in
    '
    svColumn = wsPrintAreaConfiguration.Range("rgSheetID").Column
    svStartingRow = wsPrintAreaConfiguration.Range("rgSheetID").Row + 1
    svEndingRow = wsPrintAreaConfiguration.Range("rgSheetID").Row + wsPrintAreaConfiguration.Range("rgSheetID").CurrentRegion.Rows.Count - 1
    
    svStartingAddress = Application.ConvertFormula("R" & svStartingRow & "C" & svColumn, xlR1C1, xlA1)
    svEndingAddress = Application.ConvertFormula("R" & svEndingRow & "C" & svColumn, xlR1C1, xlA1)
    
    wsPrintAreaConfiguration.Range(svStartingAddress & ":" & svEndingAddress).ClearContents
        
    For svi = svStartingRow To svEndingRow
        wsPrintAreaConfiguration.Cells(svi, svColumn).FormulaR1C1 = "=ufWorksheetid(RC[1])"
        
        svsomevar = "=IF(RC[-3]=" & """" & "Yes" & """" & "," & """" & "No" & """" & _
            ",IF(ISNA(VLOOKUP(RC[-5],rgSheetsToPrintLookups,2,FALSE))," & """" & "Not set" & """" & _
            ",VLOOKUP(RC[-5],rgSheetsToPrintLookups,2,FALSE)))"
        wsPrintAreaConfiguration.Cells(svi, svColumn + 6).FormulaR1C1 = svsomevar
    Next svi
    '
    ' Load array from listing in wsPrintAreaConfiguration
    '
    For svi = svStartingRow To svEndingRow
        svWorksheetIndex(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn).Value
        svWorksheetName(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 1).Value
        svWorksheetCodeName(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 2).Value
        svWorksheetHideForUserMode(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 3).Value
        svWorksheetMoneyScienceWorksheetType(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 4).Value
        svWorksheetOrderWithinWorksheetType(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 5).Value
        If WorksheetFunction.IsNA(wsPrintAreaConfiguration.Cells(svi, svColumn + 6).Value) Then
            svWorksheetUserHasChoosenToPrint(svi - svStartingRow + 1) = "#N/A"
        Else
            svWorksheetUserHasChoosenToPrint(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 6).Value
        End If
        svWorksheetPrintArea(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 7).Value
        svWorksheetPrintAreaIsVariable(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 8).Value
        svWorksheetVariablePrintArea(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 9).Value
        svWorksheetColumnforTagHeadings(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 10).Value
        svWorksheetOffsetforMaxValue(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 11).Value
        svWorksheetRowsToRepeatAtTop(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 12).Value
        svWorksheetColumnsToHideForPrinting(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 13).Value
        svWorksheetRightFooter(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 14).Value
        svWorksheetFitPagesToTall(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 15).Value
    Next svi
    '
    ' With an array of the worksheets in existance and those in worksheets area of wsPrintAreaConfiguration, begin the tests. The first test is
    ' see if All existing worksheets in the workbook are listed in worksheets section of wsPrintAreaConfiguration.
    '
    For svj = 1 To Worksheets.Count
        svExistsInwsPrintAreaConfiguration = False
        For svi = 1 To (svEndingRow - svStartingRow + 1)
            If svWorksheetName(svi) = svWorksheetsExisting(svj, 2) Then
                svExistsInwsPrintAreaConfiguration = True
            End If
        Next svi
        If Not svExistsInwsPrintAreaConfiguration Then
            svWorksheetsExisting(svj, 4) = "Doesn't Exist"
        End If
    Next svj
    '
    ' List all the worksheets which don't exist in wsPrintAreaConfiguration
    '
    For svj = 1 To Worksheets.Count
        If svWorksheetsExisting(svj, 4) = "Doesn't Exist" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 22, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "This is an internal error and you should contact support." & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & vbNewLine & _
                            "The worksheet " & """" & svWorksheetsExisting(svj, 2) & """" & " is not in wsPrintAreaConfiguration.", _
                            vbOKOnly, _
                            True, _
                            22
        End If
    Next svj
    '
    ' The next test is to see if All worksheets listed in the worksheets section of wsPrintAreaConfiguration exist as worksheets
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        svExistsInWorksheets = False
        For svi = 1 To Worksheets.Count
            If svWorksheetName(svj) = svWorksheetsExisting(svi, 2) Then
                svExistsInWorksheets = True
            End If
        Next svi
        If Not svExistsInWorksheets Then
            svWorksheetErrorFlag(svj) = "Doesn't Exist"
        Else
            svWorksheetErrorFlag(svj) = ""
        End If
    Next svj
    '
    ' List all the items in wsPrintAreaConfiguration which don't exist in worksheets
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetErrorFlag(svj) = "Doesn't Exist" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 23, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "This is an internal error and you should contact support." & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The wsPrintAreaConfiguration item " & """" & svWorksheetName(svj) & """" & " is not in Worksheets.", _
                            vbOKOnly, _
                            True, _
                            23
        End If
    Next svj
    '
    ' Check that the worksheet indexes are ordered sequentially and contigously.
    '
    For svj = 1 To (svEndingRow - svStartingRow)
        If svWorksheetIndex(svj) + 1 <> svWorksheetIndex(svj + 1) Then
            subDisplayError "MONEYSCIENCE Error Message #" & 24, _
                            "The worksheets are not arranged in proper order for printing." & vbNewLine & _
                            "Please contact support, see the help topic Obtaining Support." & vbNewLine & _
                            "The wsPrintAreaConfiguration item worksheet index #" & """" & svWorksheetIndex(svj) & """" & _
                            " is followed by worksheet index # " & """" & svWorksheetIndex(svj + 1) & """", _
                            vbOKOnly, _
                            True, _
                            24
        End If
    Next svj
    '
    ' Check there is a Yes/No in Hide For User Mode
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetHideForUserMode(svj) <> "Yes" And svWorksheetHideForUserMode(svj) <> "No" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 25, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "This is an internal error and you should contact support." & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The Hide for User Mode should be " & """" & "Yes" & " or " & """" & "No" & """" & vbNewLine & _
                            "and it is " & """" & svWorksheetHideForUserMode(svj) & """" & " for worksheet " & svWorksheetCodeName(svj), _
                            vbOKOnly, _
                            True, _
                            25
        End If
    Next svj
    '
    ' Next test, make sure MONEYSCIENCE Worksheet type is set correctly and is ascending.
    '
    svColumn2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Column
    svStartingRow2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Row
    svEndingRow2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Row + wsLists.Range("List_MoneyScience_Worksheet_Type").Rows.Count - 1
    
    For svj = svStartingRow2 To svEndingRow2
         svMONEYSCIENCEWorksheetType(svj - svStartingRow2 + 1) = wsLists.Cells(svj, svColumn2).Value
    Next svj
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        svValidWorksheetType = False
        For svi = 1 To (svEndingRow2 - svStartingRow2 + 1)
            If svWorksheetMoneyScienceWorksheetType(svj) = svMONEYSCIENCEWorksheetType(svi) Then
                svValidWorksheetType = True
            End If
        Next svi
        If Not svExistsInWorksheets Then
            svWorksheetMoneyScienceWorksheetType(svj) = "Invalid or Missing MONEYSCIENCE Worksheet Type"
        End If
    Next svj
    '
    ' List all the items in wsPrintAreaConfiguration with Invalid or missing worksheets
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetMoneyScienceWorksheetType(svj) = "Invalid or Missing MONEYSCIENCE Worksheet Type" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 26, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "This is an internal error and you should contact support." & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The wsPrintAreaConfiguration item " & """" & svWorksheetName(svj) & """" & " is either missing its MONEYSCIENCE worksheet type or is invalid.", _
                            vbOKOnly, _
                            True, _
                            26
        End If
    Next svj
    '
    ' Check that the "Order with Worksheet Type" is ascending for each worksheet type
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetOrderWithinWorksheetType(svj) >= svWorksheetOrderWithinWorksheetType(svj + 1) And _
            svWorksheetMoneyScienceWorksheetType(svj) = svWorksheetMoneyScienceWorksheetType(svj + 1) Then
            subDisplayError "MONEYSCIENCE Error Message #" & 27, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "The " & """" & "Order within Worksheet Type" & """" & "is not in increasing order." & vbNewLine & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The worksheet " & svWorksheetName(svj) & " has an order of " & svWorksheetOrderWithinWorksheetType(svj) & _
                            " and is followed by worksheet " & svWorksheetName(svj + 1) & " which has an order of " & svWorksheetOrderWithinWorksheetType(svj + 1), _
                            vbOKOnly, _
                            True, _
                            27
        End If
    Next svj
    '
    ' Check that the "User has chosen to Print" is either "Yes" or "No"
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetUserHasChoosenToPrint(svj) <> "Yes" And _
            svWorksheetUserHasChoosenToPrint(svj) <> "No" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 28, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "The " & """" & "User has chosen to Print" & """" & " Column should be " & """" & "Yes" & """" & " or " & """" & "No" & """" & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The worksheet " & svWorksheetName(svj) & " has " & """" & svWorksheetUserHasChoosenToPrint(svj) & """", _
                            vbOKOnly, _
                            True, _
                            28
        End If
    Next svj
    '
    ' Test # 8: Print Area should contain a valid range for "Hide for User Mode" = "No" And "Print Area is Variable" = "No"
    '
    On Error GoTo ErrNotValidRange:
    
    svErrorNo = 30
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetHideForUserMode(svj) = "No" And _
            svWorksheetPrintAreaIsVariable(svj) = "No" Then
                svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                         "The worksheet " & svWorksheetName(svj) & " for worksheet index " & """" & _
                         svWorksheetIndex(svj) & """" & vbNewLine & _
                          "contains the address " & """" & svWorksheetPrintArea(svj) & """" & _
                          " which is not a valid address range for Excel." & vbNewLine & _
                         "Contact support, see the help topic Obtaining Support for details."
                svsomevar = Range(svWorksheetPrintArea(svj)).Address
        End If
    Next svj
    '
    ' Test #9, Check there is a Yes/No in "Print Area is Variable" and if it is "Yes", make sure
    ' sure there is a valid range defined.
    '
    svErrorNo = 33
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetPrintAreaIsVariable(svj) <> "Yes" And svWorksheetPrintAreaIsVariable(svj) <> "No" Then
            subDisplayError "MONEYSCIENCE Error Message #" & 32, _
                            "Printing may not function correctly." & vbNewLine & vbNewLine & _
                            "This is an internal error and you should contact support." & vbNewLine & _
                            "See the help topic Obtaining Support." & vbNewLine & _
                            "The " & """" & "Print Area is Variable" & """" & " should be " & """" & "Yes" & " or " & """" _
                            & "No" & """" & vbNewLine & _
                            "and it is " & """" & svWorksheetPrintAreaIsVariable(svj) & """" & " for worksheet " & svWorksheetCodeName(svj), _
                            vbOKOnly, _
                            True, _
                            32
        End If
        '
        ' When it is a variable print area, report the error
        '
        If svWorksheetPrintAreaIsVariable(svj) = "Yes" Then
            svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                         "The worksheet " & svWorksheetName(svj) & " for worksheet index " & """" & _
                         svWorksheetIndex(svj) & """" & vbNewLine & _
                          "contains the address for the " & """" _
                          & "Variable Print Area including first row" & """" & " of " & """" & svWorksheetPrintArea(svj) & """" & _
                          " which is not a valid address range for Excel." & vbNewLine & _
                         "Contact support, see the help topic Obtaining Support for details."
            svsomevar = Range(svWorksheetVariablePrintArea(svj)).Address
        End If
    Next svj
    '
    ' Test #10: See if there are valid entries for columns in "Column for Tag Headings".
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetColumnforTagHeadings(svj) <> "-" And svWorksheetColumnforTagHeadings(svj) <> "Non Standard Heading" Then
            svErrorNo = 34
            svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                         "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
                         svWorksheetIndex(svj) & """" & vbNewLine & _
                          "contains the column for the " & """" _
                          & "Column for Tag Headings" & """" & " of " & """" & svWorksheetColumnforTagHeadings(svj) & """" & _
                          " which is not a valid column range Excel or it can contain " & """" & "Not Defined or Non Standard Heading" & """" & vbNewLine & _
                         "Contact support, see the help topic Obtaining Support for details."
            If Len(Range(svWorksheetColumnforTagHeadings(svj) & "1").Address) <> Len(Range(svWorksheetColumnforTagHeadings(svj) & "11").Address) Then
               ' This if will never execute but the conditions will error if it is not a valid column
            End If
        End If
    Next svj
    '
    ' Test #11: Ensure that only "Hide For User Mode" = "Yes" have "-" in "Column for Tag Headings".
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetColumnforTagHeadings(svj) = "-" And svWorksheetHideForUserMode(svj) <> "Yes" Then
            svErrorNo = 37
            svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                         "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
                          svWorksheetIndex(svj) & """" & vbNewLine & _
                          "contains the column for the " & """" & _
                          "Column for Tag Headings" & """" & " of " & """" & svWorksheetColumnforTagHeadings(svj) & """" & _
                           " which has " & """" & "Hide For User Mode  = " & """" & "-" & """" & vbNewLine & _
                           "Contact support, see the help topic Obtaining Support for details."
            subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
                            svErrorMessage, _
                            vbOKOnly, _
                            True, _
                            svErrorNo
        End If
    Next svj
    '
    ' Test #12: Ensure that "Column for Tag Headings" is within the defined print range
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetColumnforTagHeadings(svj) = "-" And svWorksheetHideForUserMode(svj) <> "Yes" Then
            If svWorksheetPrintAreaIsVariable(svj) = "Yes" Then
                svsomevar = svWorksheetVariablePrintArea(svj)
            Else
                svsomevar = svWorksheetPrintArea(svj)
            End If
            If Range(svWorksheetColumnforTagHeadings(svj)).Column < Range(svsomevar).Column Or _
               Range(svWorksheetColumnforTagHeadings(svj)).Column > Range(svsomevar).Column + Range(svsomevar).Columns.Count - 1 Then
                svErrorNo = 38
                svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                             "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
                              svWorksheetIndex(svj) & """" & vbNewLine & _
                              "has it's " & """" & _
                              "Column for Tag Headings" & """" & " outside of the print range " & """" & svsomevar & """" & _
                               "Contact support, see the help topic Obtaining Support for details."
                subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
                                svErrorMessage, _
                                vbOKOnly, _
                                True, _
                                svErrorNo
            End If
        End If
    Next svj
    '
    ' Test #13: Check to see the column "Offset for Max Value" is within the defined print range.
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetHideForUserMode(svj) = "No" Then
            If svWorksheetPrintArea(svj) = "-" Then
                svsomevar = Range(svWorksheetVariablePrintArea(svj)).Columns.Count
            Else
                svsomevar = Range(svWorksheetPrintArea(svj)).Columns.Count
            End If
            If svWorksheetOffsetforMaxValue(svj) + 1 > CLng(svsomevar) Then
                svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                             "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
                             svWorksheetIndex(svj) & """" & vbNewLine & _
                              "has a " & """" & "Offset for Max Value" & """" & " outside of the designated print range." & vbNewLine & _
                             "Contact support, see the help topic Obtaining Support for details."
            subDisplayError "MONEYSCIENCE Error Message #" & 35, _
                            svErrorMessage, _
                            vbOKOnly, _
                            True, _
                            35
            End If
        End If
    Next svj
    '
    ' Test # 14: See if it is a valid row range for the rows to repeat at thet top.
    '
    For svj = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetRowsToRepeatAtTop(svj) <> "-" Then
            If Not IsNumeric(Mid(svWorksheetRowsToRepeatAtTop(svj), 2, InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") - 2)) Or _
               Not IsNumeric(Mid(svWorksheetRowsToRepeatAtTop(svj), InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") + 2, 255)) Or _
               Mid(svWorksheetRowsToRepeatAtTop(svj), 2, InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") - 2) > _
               Mid(svWorksheetRowsToRepeatAtTop(svj), InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") + 2, 255) Then
                    svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                             "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
                             svWorksheetIndex(svj) & """" & vbNewLine & _
                              "has a " & """" & "Rows to Repeat at Top" & """" & " of " & """" & svWorksheetRowsToRepeatAtTop(svj) & """" & " which is invalid.." & vbNewLine & _
                             "Contact support, see the help topic Obtaining Support for details."
                    subDisplayError "MONEYSCIENCE Error Message #" & 36, _
                            svErrorMessage, _
                            vbOKOnly, _
                            True, _
                            36
            End If
        End If
    Next svj
    '
    ' Test #15: to see that each entry in "Columns to Hide for Printing" is a Valid Column
    '
    svErrorNo = 37
    For svj = 1 To (svEndingRow - svStartingRow + 1)
       svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
            "The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
            svWorksheetIndex(svj) & """" & vbNewLine & _
             "has an invalid " & """" & "Columns To Hide for Printing" & """" & " of " & """" & svWorksheetColumnsToHideForPrinting(svj) & """" & vbNewLine & _
            "Contact support, see the help topic Obtaining Support for details."
        svColumnsToHideForPrinting = svWorksheetColumnsToHideForPrinting(svj)
        If svColumnsToHideForPrinting <> "-" Then
            If InStr(1, svColumnsToHideForPrinting, ",") = 0 Then
                svColumnToHide = Range("$" & svColumnsToHideForPrinting & "$1").Address
            Else
                Do
                    svCommaIsAt = InStr(1, svColumnsToHideForPrinting, ",")
                    svColumnToHide = Mid(svColumnsToHideForPrinting, 1, svCommaIsAt - 1)
                    svColumnToHide = "$" & svColumnToHide & "$" & "1"
                    svColumnToHide = Range(svColumnToHide).Address
                    svColumnsToHideForPrinting = Mid(svColumnsToHideForPrinting, svCommaIsAt + 1, 255)
                Loop Until InStr(1, svColumnsToHideForPrinting, ",") = 0
                svColumnToHide = "$" & svColumnsToHideForPrinting & "$" & "1"
                svColumnToHide = Range(svColumnToHide).Address
            End If
        End If
    Next svj
        '
    ' Test #16: Ensure all the right footers are unique
    '
    '
    wsScratch.Range("$A:$B").Clear
    svsomevar = Application.ConvertFormula("R" & Range("rgSheetID").Row + 1 & "C" & _
                wsPrintAreaConfiguration.Range("rnRightFooter").Column, xlR1C1, xlA1) _
                & ":" & Application.ConvertFormula("R" & wsPrintAreaConfiguration.Range("rgSheetID").Row _
                + wsPrintAreaConfiguration.Range("rgSheetID").CurrentRegion.Rows.Count - 1 & "C" & _
                wsPrintAreaConfiguration.Range("rnRightFooter").Column, xlR1C1, xlA1)
    wsPrintAreaConfiguration.Range(svsomevar).Copy wsScratch.Range("$A$1")
    Application.CutCopyMode = False
    
    wsScratch.Range("$A$1").CurrentRegion.removeduplicates Columns:=1, Header:=xlNo
    svWorksheetTotalUniqueRightFootersCount = wsScratch.Range("$A$1").CurrentRegion.Rows.Count
    For svj = 1 To svWorksheetTotalUniqueRightFootersCount
        svWorksheetUniqueRightFooters(svj) = wsScratch.Cells(svj, 1).Value
        svWorksheetUniqueRightFootersCount(svj) = 0
    Next svj
    wsScratch.Range("$A:$B").Clear
    '
    '
    '
    For svi = 1 To (svEndingRow - svStartingRow + 1)
        For svj = 1 To svWorksheetTotalUniqueRightFootersCount
            If svWorksheetUniqueRightFooters(svj) = svWorksheetRightFooter(svi) And _
                svWorksheetUniqueRightFooters(svj) <> "-" Then
                svWorksheetUniqueRightFootersCount(svj) = svWorksheetUniqueRightFootersCount(svj) + 1
            End If
        Next svj
    Next svi
    '
    ' Report on duplicate footer usage
    '
    For svj = 1 To svWorksheetTotalUniqueRightFootersCount
        If svWorksheetUniqueRightFootersCount(svj) > 1 And svWorksheetUniqueRightFooters(svj) <> "-" Then
                svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
                             "The worksheet footer " & """" & svWorksheetUniqueRightFooters(svj) & """" & " is used " & _
                             svWorksheetUniqueRightFootersCount(svj) & " times." & vbNewLine & _
                             "Contact support, see the help topic Obtaining Support for details."
            subDisplayError "MONEYSCIENCE Error Message #" & 39, _
                            svErrorMessage, _
                            vbOKOnly, _
                            True, _
                            39
        End If
    Next svj
    '
    ' 17) Make sure the variable print area covers the used region.
    '
    For svi = 1 To (svEndingRow - svStartingRow + 1)
        If svWorksheetPrintAreaIsVariable(svi) = "Yes" Then
'-------------------------------------------------------------------
            svVariablePrintAreaDef = svWorksheetVariablePrintArea(svi)      ' Need specific worksheet here
            svVariablePrintAreaStartingColumn = Range(svVariablePrintAreaDef).Column
            svVariablePrintAreaTotalColumns = Range(svVariablePrintAreaDef).Columns.Count
            
            
            svtempvar = Mid(svVariablePrintAreaDef, InStr(1, svVariablePrintAreaDef, ":") + 1, 255)
            svtempcol = Application.ConvertFormula("R1C" & Range(svtempvar).Column, xlR1C1, xlA1)    ' Turn column # into valid xlA1 cell address
            svtempcol = Mid(svtempcol, 2, InStr(2, svtempcol, "$") - 2)
            
            svtemprow = Range(svtempvar).Row - 1
            
            svCurrentRegion = Worksheets(svWorksheetIndex(svi)).Range("$" & svtempcol & "$" & svtemprow).CurrentRegion.Address ' Need specific worksheet here
        
            svCurrentRegionStartingColumn = Range(svCurrentRegion).Column
            svCurrrentRegionTotalColumns = Range(svCurrentRegion).Columns.Count
            
            If svVariablePrintAreaStartingColumn <> svCurrentRegionStartingColumn Or _
                svVariablePrintAreaTotalColumns <> svCurrrentRegionTotalColumns Then
            End If
'-------------------------------------------------------------------
        End If
    Next svi
    '
    '
    ' For the items in wsPrintAreaConfiguration which are not hidden from the user, put them into wsSheetsToPrint
    ' and then copy them, paste special as values. Go to the original user entered values, clear these out and
    ' name the range rgSheetsToPrintLookups. If any of the values are not equal to Yes or No for Include in Printing,
    ' then set it to No as a default.
    '
    ' The resason for doing this is that by creating the list of worksheets to print from wsPrintAreaConfiguration,
    ' this will always ensure that if reported errors were dealt with, the list in wsSheetsToPrint will be
    ' accurate and contain the users last settings.
    '
    '
    svSheetsToPrintProtectContents = wsSheetsToPrint.ProtectContents
    If svSheetsToPrintProtectContents Then
        wsSheetsToPrint.Unprotect "Money"
    End If
    svi = 9 ' Starting row in Worksheets to Print where first worksheet can be found.
    For svj = 1 To (svEndingRow - svStartingRow)
        If svWorksheetHideForUserMode(svj) = "No" Then
            wsSheetsToPrint.Cells(svi, 6).Value = svWorksheetName(svj)
            If svWorksheetUserHasChoosenToPrint(svj) <> "Yes" And svWorksheetUserHasChoosenToPrint(svj) <> "No" Then
                wsSheetsToPrint.Cells(svi, 7).Value = "No"
            Else
                wsSheetsToPrint.Cells(svi, 7).Value = svWorksheetUserHasChoosenToPrint(svj)
            End If
            svi = svi + 1
        End If
    Next svj
    '
    '
    '
    svCurrentUserWorksheet = ActiveSheet.Name
    wsSheetsToPrint.Select
    
    
    Set rgWorkSheetNames = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                        wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, -1))
                        
    Set rgIncludeInPrinting = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                            wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, 1))
                            
    Set rgSheetsToPrintListing = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                                wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1))
    rgSheetsToPrintListing.Clear
  
    wsSheetsToPrint.Range("F9").CurrentRegion.Copy wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").Offset(1)
    '
    ' Since the copy may have created more rows, redefine the ranges
    '
    Set rgWorkSheetNames = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                        wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, -1))
                        
    Set rgIncludeInPrinting = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                            wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, 1))
                            
    Set rgSheetsToPrintListing = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
                                wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1))

    wsSheetsToPrint.Range("F:G").Delete
    
    rgWorkSheetNames.Style = "RH Text Left Center"
    rgIncludeInPrinting.Style = "Input Text Center"
    
    With rgIncludeInPrinting.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=List_YesNo"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    '
    ' Redefine the range rgSheetsToPrintLookups
    '
    With ActiveWorkbook.Names("rgSheetsToPrintLookups")
        .Name = "rgSheetsToPrintLookups"
        .RefersToR1C1 = "='Sheets To Print'!" & rgSheetsToPrintListing.Address(True, True, xlR1C1)
        .Comment = ""
    End With
    '
    '
    '
    If svSheetsToPrintProtectContents Then
        wsSheetsToPrint.Protect "Money"
    End If
    '
    ' Restore calculation, screen updating and enable events settings
    '
    Application.Calculation = svApplicationCalculation
    Application.ScreenUpdating = svApplicationScreenUpdating
    Application.EnableEvents = svApplicationEnableEvents
    
    Worksheets(svCurrentUserWorksheet).Select
    
    Exit Sub

ErrNotValidRange:
    If Err.Number = 1004 Then
        subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
                        svErrorMessage, _
                         vbOKOnly, _
                         True, _
                          svErrorNo
        Resume Next
    Else
            subDisplayError "MONEYSCIENCE Error Message #" & 31, _
                         "Printing may not function correctly." & vbNewLine & vbNewLine & _
                         "Error Code: " & Err.Number & vbNewLine & _
                         "Error Description: " & Err.Description & vbNewLine & _
                         "Contact support, see the help topic Obtaining Support for details.", _
                         vbOKOnly, _
                         True, _
                          31
        Resume Next
    End If
End Sub
 
'
'
Sub subGetCurrentVersionFromTheWeb()
    Dim Style As Long
    Dim Title As String
    Dim ErrorMessage As String
    Dim Response As Variant
    
    On Error GoTo ErrHandlerNoWebFile:
    
    Workbooks.Open ("[URL]http://www.bandgservices.com/Documents/CurrentVersion.txt[/URL]")
    pvLifeProfilerVersion = Workbooks("CurrentVersion.txt").Worksheets("CurrentVersion").Range("A1").Value
    Workbooks("CurrentVersion.txt").Close
    
    Exit Sub
    
ErrHandlerNoWebFile:
    
    If Err.Number = 1004 Then
        Style = vbOKOnly                                                                    ' Define buttons.
        Title = "MoneyScience Error Message #19"
        ErrorMessage = "In all likelihood, you are not connected to the Internet. All this means is that MONEYSCIENCE's LifeProfiler" & vbNewLine & _
                    "will not be able to check for a more recent version of the software." & vbNewLine & vbNewLine & _
                    "If you are connected and have verified this, then contact support." & vbNewLine & vbNewLine & _
                    "See the help topic Obtaining Support for details."
        Response = MsgBox(ErrorMessage, Style, Title)
    Else
        Style = vbOKOnly                                                                    ' Define buttons.
        Title = "MoneyScience Error Message #20"
        ErrorMessage = "An unknown error has occurred. Please take a screen shot or write down all the " & vbNewLine & _
                    "details of this message and then contact support." & vbNewLine & vbNewLine & _
                    "See the help topic Obtaining Support for details." & vbNewLine & vbNewLine & _
                    "Err.Number = " & Err.Number & ": " & Err.Description
        Response = MsgBox(ErrorMessage, Style, Title)
    End If
End Sub
 

'Note: Do not change the code above

Sub subShowDeveloperMenu()
    Call RefreshRibbon(Tag:="MSDeveloperGroupTag")
End Sub

I suspect there may subroutines I've not includded but if you've read this and want more, let me know.
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,935
Office Version
  1. 365
Platform
  1. Windows
This code is just bad.:)

More than 1k+ lines of code.:eek:

Also, the use of On Error might actualy be hiding problems.
 

billbrunt

Board Regular
Joined
Jul 17, 2009
Messages
178
Norie...from your posts, I've no doubt you know what you're talking about. Is there any specific areas you can point me to which are bad and what it should be?
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,749
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Hi,

Try this trick:

1. In ThisWorkbook module rename your Workbook_Open() subroutine to DelayedOpen()

2. Add to ThisWorkbook module new Workbook_Open() subroutine with such code:
Rich (BB code):

Private Sub Workbook_Open()
  With ThisWorkbook
    Application.OnTime Now, .Name & "!" & .CodeName & ".DelayedOpen"
  End With
End Sub

Regards,
Vladimir
 

Isabella

Well-known Member
Joined
Nov 7, 2008
Messages
643

ADVERTISEMENT

Great trick Vladimir, but say if a Workbook has array formulas over many cells, and it takes about 1 minute to open, is it a good idea to open in Manual mode, if so then each workbk that is open needs to to be closed prior to the target wkbk macro to work, is there a workaround this issue?

Hi,

Try this trick:

1. In ThisWorkbook module rename your Workbook_Open() subroutine to DelayedOpen()

2. Add to ThisWorkbook module new Workbook_Open() subroutine with such code:
Rich (BB code):
Private Sub Workbook_Open()
 With ThisWorkbook
   Application.OnTime Now, .Name & "!" & .CodeName & ".DelayedOpen"
 End With
End Sub

Regards,
Vladimir
 

billbrunt

Board Regular
Joined
Jul 17, 2009
Messages
178
I'm relatively new to VBA so what is the core issue and why does it blink?
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,749
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

I'm relatively new to VBA so what is the core issue and why does it blink?
I did not analyze your code and I won’t make any comments on it, just have looked its structure and your description. My guess is that it’s blinking because it’s hanging. And it’s happens when all Excel windows are closed, and you open workbook from explorer or by clicking shortcut.
If so then try the suggestion of the post #4. If it will help I can provide more comments about the trick.
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,749
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Great trick Vladimir, but say if a Workbook has array formulas over many cells, and it takes about 1 minute to open, is it a good idea to open in Manual mode, if so then each workbk that is open needs to to be closed prior to the target wkbk macro to work, is there a workaround this issue?
Hi Isabella,

I don't understand the reason to close other workbooks before running the macro. Workbook can be saved with VBA-disabled calculation of required sheet(s) and it does not calculate at loading even at Application.Calculation = xlCalculationAutomatic and volatile functions presence. Restoring of calculation of such sheets can be made by VBA-code after workbook loading and after the macro running if required. But it is clear that at restoration of sheet calculation your 1 minute happen all the same.

There are many examples on the forum with other possible ways to speed up calculation of the sheet, for example formula optimization, data structure optimization, VBA processing instead of array formulas etc. The choice of the method depends from the formulas used, its references, from other details of issue, preferences, skills, and so on.

But it seems that your issue subject is different to this thread one.

Regards,
Vladimir
 

billbrunt

Board Regular
Joined
Jul 17, 2009
Messages
178
Vladimir -

It appears the code you provided worked. I didn't know if it did right away as this appeared to be an intermittment problem and it hasn't occured since I put your suggestion in place.

You mentioned you could provide more comments about the trick and I'd love to hear it.

Lastly, I want to say thank you very much. This was an aggrevating problem which cost myself and my client time. I'm very grateful for your suggestion. Nice work and thanks again.

- Bill
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,749
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Thank you for feedback, Bill.

Let me explain the trick details.
Let’s assume that the workbook with Workbook_Open() event macro should be loaded into Excel.

There are two possible situations as follows:

1. Excel is already open before loading of workbook. Previous instance of Excel application is used in this (happy) case. Excel just creates new window of application for the loading of workbook and its events macros fulfills without issues.

2. No active Excel windows are present before loading of workbook. New Excel application is created, then add-ins' are loaded, after that Excel loads the workbook and triggers its events macro(s). The issue is in the fact that workbook events, including Workbook_Open(), raise before the full loading of Excel which can cause the Excel internal buffer memory hanging (seen as Excel entry in status bar blinks). That is, Excel is not ready to work with its full object model till the complete loading.

The trick for the 2nd case is in usage of Application.OnTime method for waiting of complete Excel loading, in other words for the delayed call of the code of DelayedMacro().

Typically the macro call with minimal 1 second delay looks like this:
Application.OnTime Now + TimeValue("00:00:01"), "DelayedMacro"

But we need not wait an extra 1 second and can call DelayedMacro() from Workbook_Open() in such way:
Application.OnTime Now + TimeValue("00:00:00"), "DelayedMacro"
or, the same:
Application.OnTime Now, "DelayedMacro"

Regardless of the zero charged delay Excel will automatically wait from milliseconds up to seconds if it’s required for complete loading, and only after that runs DelayedMacro() in which all the triggering code should be stored.

Cheers,
Vladimir
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,114,470
Messages
5,548,207
Members
410,824
Latest member
Bobmn4
Top