Attend Excelapalooza
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 3 123 LastLast
Results 1 to 10 of 22

Thread: Weird excel error

  1. #1
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Weird excel error

    So I have a macro enabled workbook that when i open it it always says file not found and highlights workbook_open. But if i go to my one module and delete all the info in there and tab out a few areas of my code in the workbook_open then it will work. Then when I re add back that stuff and untab the stuff it works. Makes no sense to me lol. Here is the module and the thisworksheet module. I cannot for the life of me figure this out but I think it might have to do with one of the api's not being able to find the correct dll? Since it highlights the workbook_open and never triggers the error handler I cant figure out which file is not found.

    Code:
    Option Explicit
    
    
    Public Sub Workbook_Open()
        
        On Error GoTo ErrorHandler
        'Speed up vba code
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        
        'Icon Update
        'Call SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0) ' THis is one i tab out to fix error since routine is in module      that i delete to fix error
        
        'Seperate Instance Declaration
        Set ExcelGUIUpdates.App = Application
        
        'Delete itself from history
        Call ExcelGUIUpdates.DeleteRecentlyOpened
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        'Create Regex Object string testing
        Set RegEx = CreateObject("VBScript.RegExp")
        
        'Application.DisplayAlerts = True
        
        With Userform1
            .StartUpPosition = 0
            .Left = (0.5 * GetSystemMetrics(SM_CXSCREEN)) * 0.75 - (0.5 * .Width)
            .Top = (0.5 * GetSystemMetrics(SM_CYSCREEN)) * 0.75 - (0.5 * .Height) - 10
            .Show vbModeless
        End With
    
    
    'File not found error - NO clue but Resave. Then Open again then save as next version. Then save that. Then reopen and resave as something else and that one should work
    Exit Sub
    
    
    ErrorHandler:
    Debug.Print "Error Number: " & Err.Number & ", Error Message: " & Err.Description & ", Last DLL Error: " & Err.LastDllError
    
    
    End Sub
    
    
    Sub Test()
    
    
    Application.Quit
    
    
    End Sub
    Code:
    Option Explicit
    '--------------------------------Create Icons Variable Declarations (API Mainly)----------------------------------'
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' modSetIcon
    ' This module contains code to change the icon of the Excel main
    ' window. The code is compatible with 64-bit Office.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If  VBA7 And Win64 Then
    '''''''''''''''''''''''''''''
    ' 64 bit Excel
    '''''''''''''''''''''''''''''
    Private Declare PtrSafe Function SendMessageA Lib "user32" _
          (ByVal hWnd As LongPtr, _
          ByVal wMsg As LongPtr, _
          ByVal wParam As LongPtr, _
          ByVal lParam As LongPtr) As LongPtr
    
    
    Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
          (ByVal hInst As LongPtr, _
          ByVal lpszExeFileName As String, _
          ByVal nIconIndex As LongPtr) As Long
    
    
    Private Const ICON_SMALL = 0&
    Private Const ICON_BIG = 1&
    Private Const WM_SETICON = &H80
    
    
    #Else 
    '''''''''''''''''''''''''''''
    ' 32 bit Excel
    '''''''''''''''''''''''''''''
    Private Declare Function SendMessageA Lib "user32" _
          (ByVal hWnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Integer, _
          ByVal lParam As Long) As Long
    
    
    Private Declare Function ExtractIconA Lib "shell32.dll" _
          (ByVal hInst As Long, _
          ByVal lpszExeFileName As String, _
          ByVal nIconIndex As Long) As Long
    
    
    Private Const ICON_SMALL As Long = 0&
    Private Const ICON_BIG As Long = 1&
    Private Const WM_SETICON As Long = &H80
    #End  If
    
    
    '-------------Lightbox userform windowframe removal Variable Declariations (API Mainly)----------------------------'
    'All Windows API variables that must be declared via module and not class module
    'Hide userform window frames. Used in class module HideTitleBar
    Public Const GWL_STYLE = -16
    Public Const WS_CAPTION = &HC00000
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    Public Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hWnd As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    
    '------------------------------Open file API Calls--------------------------------------------'
    #If  VBA7 And Win64 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
      ByVal lpOperation As String, ByVal lpFile As String, _
      ByVal lpParameters As String, ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long
    #Else 
    Private Declare Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
      ByVal lpOperation As String, ByVal lpFile As String, _
      ByVal lpParameters As String, ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long
    #End  If
    
    
    
    
    '--------------------------------Create Icons--------------------------------------------------'
    Sub SetIcon(FileName As String, Optional index As Long = 0)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetIcon
    ' This procedure sets the icon in the upper left corner of
    ' the main Excel window. FileName is the name of the file
    ' containing the icon. It may be an .ico file, an .exe file,
    ' or a .dll file. If it is an .ico file, Index must be 0
    ' or omitted. If it is an .exe or .dll file, Index is the
    ' 0-based index to the icon resource.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If  VBA7 And Win64 Then
        ' 64 bit Excel
        Dim hWnd As LongPtr
        Dim HIcon As LongPtr
    #Else 
        ' 32 bit Excel
        Dim hWnd As Long
        Dim HIcon As Long
    #End  If
        Dim n As Long
        Dim S As String
        If Dir(FileName, vbNormal) = vbNullString Then
            ' file not found, get out
            Exit Sub
        End If
        ' get the extension of the file.
        n = InStrRev(FileName, ".")
        S = LCase(Mid(FileName, n + 1))
        ' ensure we have a valid file type
        Select Case S
            Case "exe", "ico", "dll"
                ' OK
            Case Else
                ' invalid file type
                Err.Raise 5
        End Select
        hWnd = Application.hWnd
        If hWnd = 0 Then
            Exit Sub
        End If
        HIcon = ExtractIconA(0, FileName, index)
        If HIcon <> 0 Then
            SendMessageA hWnd, WM_SETICON, ICON_SMALL, HIcon
        End If
    End Sub
    
    
    
    
    '------------------------Lightbox userform windowframe removal-----------------------------'
    Sub HideTitleBar(frm As Object)
    
    
        Dim lngWindow As Long
        Dim lFrmHdl As Long
        lFrmHdl = FindWindowA(vbNullString, frm.Caption)
        lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
        lngWindow = lngWindow And (Not WS_CAPTION)
        Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
        Call DrawMenuBar(lFrmHdl)
        
    End Sub
    
    
    '------------------------Allow user to return single file from filedialog-------------------------'
    
    
    Function SingleFilePath()
    
    
    Dim intChoice As Integer
    Dim strPath As String
    
    
    'only allow the user to select one file
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    
    'determine what choice the user made
    If intChoice <> 0 Then
        'get the file path selected by the user
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        'return the filepath
        SingleFilePath = strPath
    End If
    
    
    End Function
    
    
    '---------------------Allow user to return multiple files from filedialog---------------------'
    Function MultipleFilePath() As String()
    
    
    Dim intChoice As Integer
    Dim strPath() As String
    Dim i As Integer
    
    
    'allow the user to select multiple files
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    
    'determine what choice the user made
    If intChoice <> 0 Then
        'get the file path selected by the user
        For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.count
            strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)
        Next i
    End If
    
    
    MultipleFilePath = strPath
    
    
    End Function
    
    
    'Open files command
    
    
    Sub OpenFile(StringPath As String)
        If fso.GetExtensionName(StringPath) = "xls" Or fso.GetExtensionName(StringPath) = "xlsm" _
            Or fso.GetExtensionName(StringPath) = "xlsx" Then
        
            Dim xlApp As Application
            Set xlApp = CreateObject("Excel.Application")
            Application.DisplayAlerts = False
            xlApp.Workbooks.Open StringPath, , True
            Application.DisplayAlerts = True
            xlApp.Visible = True
            Set xlApp = Nothing
             
        ElseIf fso.GetExtensionName(StringPath) = "doc" Or fso.GetExtensionName(StringPath) = "pdf" _
            Or fso.GetExtensionName(StringPath) = "txt" Then
        
            Dim Result As Long
            Result = ShellExecute(0&, vbNullString, StringPath, _
            vbNullString, vbNullString, vbNormalFocus)
            If Result < 32 Then MsgBox "Error"
            
       Else
       
            Dim objShell As Object
            Set objShell = CreateObject("Shell.Application")
            Application.DisplayAlerts = False
            objShell.Open (StringPath)
            Application.DisplayAlerts = True
            Set objShell = Nothing
            
        End If
    End Sub
    
    
    'Copy files without waiting for file transfer to resume code
    Sub FileCopyImproved(sSourceFile As String, sDestFile As String)
        
        'Asynch File Copy
        Shell Environ$("comspec") & " /c xcopy /y """ & sSourceFile & """ """ & sDestFile & "*" & """ ", vbHide
        
    End Sub
    
    
    
    
    Function CorrectMMCIDFormat(MMCIDEntered As String)
    
    
    'Check Formatting of MMCID Entered
            If Len(MMCIDEntered) = 11 Then
                
                RegEx.Pattern = "[A-Za-z]"
                If RegEx.Test(Left(MMCIDEntered, 2)) Then
                
                    RegEx.Pattern = "^[0-9]+$"
                    If RegEx.Test(Right(MMCIDEntered, 8)) Then
                        
                        If Mid(MMCIDEntered, 3, 1) = "-" Then
                        
                            
                            CorrectMMCIDFormat = True
                            
                        Else
                        
                            CorrectMMCIDFormat = False
                        
                        End If
                    
                    Else
                        
                        CorrectMMCIDFormat = False
                    
                    End If
                
                Else
                    
                    CorrectMMCIDFormat = False
                
                End If
            
            Else
                
                CorrectMMCIDFormat = False
            
            End If
    
    
    End Function
    
    
    Function stripEnclosed(strIn As String) As String
    'need to enable ms vbscript regular
    Dim re As VBScript_RegExp_55.RegExp, AllMatches As VBScript_RegExp_55.MatchCollection, M As VBScript_RegExp_55.Match
    Dim closeIndex As Long
    Dim tmpstr As String
    tmpstr = strIn
    Set re = New VBScript_RegExp_55.RegExp
    re.Global = True
    re.Pattern = "<[^/>]+>"
    Set AllMatches = re.Execute(tmpstr)
    For Each M In AllMatches
        closeIndex = InStr(tmpstr, Replace(M.value, "<", " 0 Then tmpstr = Left(tmpstr, InStr(tmpstr, M.value) - 1) & Mid(tmpstr, closeIndex + Len(M.value) + 1)
    Next M
    stripEnclosed = tmpstr
    End Function
    
    
    Public Function StripHTML(str As String) As String
    
    
    Dim RegEx As Object
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
        .Pattern = "<[^>]+>"
    End With
    
    
    StripHTML = RegEx.Replace(str, "")
    Set RegEx = Nothing
    
    
    End Function
    
    
    Sub ProcessStepTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentStep As Integer
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim MaxOrdering As Integer
        Dim IsIterative As Boolean
        Dim CurrentOrder As Integer
        Dim CurrentRound As Integer
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.ROUND DESC,PRT.DATE_ENTERED DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        LastProcessStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        CurrentRound = ActiveRecordset.Fields("ROUND").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
    
    
        If LastProcessStep = MaxVersionStep Then
        
            If IsIterative Then
            
                SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                CurrentRound = CurrentRound + 1
                
            Else
            
                SQLQueryCode = "SELECT T3.NEXT_VERSION_NUMBER, T4.PROCESS_STEP_DISPLAY_TEXT FROM (SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON " & _
                                "(Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) WHERE BaseReview.MMCID = " & ActiveMMCID & " ) AS T1 " & _
                                " INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING ) AS T3 INNER JOIN Process_Ordering AS T4 ON T3.NEXT_VERSION_NUMBER=T4.PROCESS_SET_VERSION WHERE PROCESS_ID_NUMBER=1"
    
    
                
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                If ActiveRecordset.RecordCount = 0 Then
                
                    ProcessVersionTrackingVar = Null
                    ProcessConfirmationMessage = ""
                    
                Else
                
                    'Append basereview table for new version number
                    SQLQueryCode = "UPDATE BASEREVIEW" & _
                                   " SET PROCESS_ORDERING_SET_DD=" & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & _
                                   " WHERE MMCID=" & ActiveMMCID
                
                    Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                
                    'New version always has first step as 1
                    ProcessVersionTrackingVar = 1
                    CurrentRound = 1
                    CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                    ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                        
                End If
            
            End If
        
        Else
        
            ProcessVersionTrackingVar = LastProcessStep + 1
            
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            
        End If
    
    
        'Update Table
        If Not IsNull(ProcessVersionTrackingVar) Then
            
            'Jerry rig for fake DMCP entries for steps 9, 10, 11
            If (ProcessVersionTrackingVar = 9 Or ProcessVersionTrackingVar = 10 Or ProcessVersionTrackingVar = 11) And CurrentVersion = ProcessVersionQuestionSet Then
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            Else
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            End If
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Sub
    
    
    Sub ProcessVersionTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentVersion As Integer
        Dim CurrentRound As Integer
        
        SQLQueryCode = "SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, " & _
                        " Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON (Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) " & _
                        " WHERE BaseReview.MMCID = " & MMCID & " ) AS T1 INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        'Assume first step in process version is always 1
        ProcessVersionTrackingVar = 1
        CurrentRound = 1
        
        'Update Table
        If ActiveRecordset.RecordCount > 0 Then
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                           " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            
            SQLQueryCode = "UPDATE BASEREVIEW SET PROCESS_ORDERING_SET_DD = " & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & " WHERE MMCID= " & MMCID
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
    
    
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Sub
    
    
    Function NextStepButtonText(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean) As String
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentStep As Integer
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim MaxOrdering As Integer
        Dim IsIterative As Boolean
        Dim CurrentOrder As Integer
        Dim CurrentRound As Integer
        Dim ButtonText As String
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        LastProcessStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        CurrentRound = ActiveRecordset.Fields("ROUND").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
    
    
        If LastProcessStep = MaxVersionStep Then
        
            If IsIterative Then
            
                SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                CurrentRound = CurrentRound + 1
                ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
                
            Else
            
                SQLQueryCode = "SELECT PROCESS_VERSION_NUMBER FROM PROCESS_VERSION_ORDERING WHERE ORDERING=" & CurrentOrder + 1
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                If IsNull(ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value) Then
                
                    ProcessVersionTrackingVar = Null
                    ProcessConfirmationMessage = ""
                    ButtonText = "Null"
                Else
                
                    SQLQueryCode = "SELECT PROCESS_ID_NUMBER, PROCESS_SET_VERSION,PROCESS_STEP_DISPLAY_TEXT,PROCESS_ACTION_BUTTON_TEXT FROM PROCESS_ORDERING WHERE PROCESS_SET_VERSION=" & ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value & " AND PROCESS_ID_NUMBER>0 ORDER BY PROCESS_ID_NUMBER ASC"
                    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
                    ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                    CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                    ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                    ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
    
    
                End If
            
            End If
        
        Else
        
            ProcessVersionTrackingVar = LastProcessStep + 1
            
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
            
        End If
    
    
        'Update Table
        NextStepButtonText = ButtonText
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Function
    
    
    Function IsMaxProcessStep(MMCID As Integer, CheckIterative As Boolean, connectionOpen As Boolean)
    
    
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim CurrentOrder As Integer
        Dim IsIterative As Boolean
        
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
        LastStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
        
        If CheckIterative = True Then
            If LastStep = MaxVersionStep And IsIterative = True Then
                IsMaxProcessStep = True
            Else
                IsMaxProcessStep = False
            End If
        Else
            If LastStep = MaxVersionStep Then
                IsMaxProcessStep = True
            Else
                IsMaxProcessStep = False
            End If
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
    
    
    End Function
    
    
    'This is for the update of the validating documents. Since the dynamic button class cant access forms subroutines we have to put it here
    Sub ActivateValidateDocs(DocumentToValidate As String)
         
        DocumentValidated = DocumentToValidate
        'Clear old Contents
        MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc.Clear
    
    
        'ACTIVATE THE SCREEN!
        With MMCARMS.MMCIDMainBlurrImage
            .Width = MMCARMS.Width
            .Height = MMCARMS.Height
            .Top = 0
            .Left = 0
            .Visible = True
            .ZOrder (0)
        End With
        
        With MMCARMS.ValidateDocFrame
            .Height = 204
            .Width = 354
            .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
            .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height) - 10
            .Visible = True
            .ZOrder (0)
        End With
    
    
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    
    
        'Find definitions to fill dropdown box
        SQLQueryCode = "SELECT DTT.DOC_TYPE_DESCRIPTION,DTT.DOC_TYPE_DD,DTT.DOC_GROUP_TYPE_DD FROM DOCUMENTATION_TYPE_TAB DTT WHERE DTT.DOC_GROUP_TYPE_DD=2 ORDER BY DTT.DOC_GROUP_TYPE_DD ASC, DTT.DOC_TYPE_DD ASC"
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
        DatabaseMethods.SQLCloseDatabaseConnection
        
        With MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc
            'Add item to state dropdown
            .AddItem "Select A Document Type"
        
            'Load the State into the dropdown lists as items
            While Not ActiveRecordset.EOF
                .AddItem ActiveRecordset.Fields("DOC_TYPE_DESCRIPTION").value
                ActiveRecordset.MoveNext
            Wend
    
    
            .ListIndex = 0
        End With
        
    End Sub
    
    
    
    
    'This for bringing up the add new policy subroutine
    Sub NewCommentBoxPolicy(PolicyGrouping As Integer)
    
    
        'Clear All variables
        MMCARMS.CommentTextBox_POL.Text = ""
        MMCARMS.CommentText_POL.Caption = "Please use the textbox below to add your comment for Policy Item " & PolicyGrouping & "."
        ActivePolicyGrouping = PolicyGrouping
    
    
        With MMCARMS.MMCIDMainBlurrImage
            .Width = MMCARMS.Width
            .Height = MMCARMS.Height
            .Top = 0
            .Left = 0
            .Visible = True
            .ZOrder (0)
        End With
        
        With MMCARMS.Comment_POLFrame
            .Height = 336
            .Width = 468
            .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
            .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height)
            .Visible = True
            .ZOrder (0)
        End With
       
    End Sub
    
    
    Sub UpdatedResolved(PolicyGrouping As Integer)
    
    
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        SQLQueryCode = "INSERT INTO POLICY_GROUP_RESOLUTION(MMCID,WHO_RESOLVED, WHEN_RESOLVED, POLICY_GROUPING,RESOLVED) " & _
                       "VALUES(" & ActiveMMCID & "," & UserNumber & ",FORMAT(#" & Now() & "#,'MM/DD/YYYY HH:mm:ss')," & PolicyGrouping & ", TRUE)"
        Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
        DatabaseMethods.SQLCloseDatabaseConnection
    
    
        MMCARMS.FillPolTab_MRP
    End Sub
    
    
    Public Function SortDictionaryByValue(dict As Object _
                        , Optional sortorder As XlSortOrder = xlAscending) As Object
        
        On Error GoTo eh
        
        Dim arrayList As Object
        Set arrayList = CreateObject("System.Collections.ArrayList")
        
        Dim dictTemp As Object
        Set dictTemp = CreateObject("Scripting.Dictionary")
       
        ' Put values in ArrayList and sort
        ' Store values in tempDict with their keys as a collection
        Dim key As Variant, value As Variant, coll As Collection
        For Each key In dict
        
            value = dict(key)
            
            ' if the value doesn't exist in dict then add
            If dictTemp.Exists(value) = False Then
                ' create collection to hold keys
                ' - needed for duplicate values
                Set coll = New Collection
                dictTemp.Add value, coll
                
                ' Add the value
                arrayList.Add value
                
            End If
            
            ' Add the current key to the collection
            dictTemp(value).Add key
        
        Next key
        
        ' Sort the value
        arrayList.Sort
        
        ' Reverse if descending
        If sortorder = xlDescending Then
            arrayList.Reverse
        End If
        
        dict.RemoveAll
        
        ' Read through the ArrayList and add the values and corresponding
        ' keys from the dictTemp
        Dim item As Variant
        For Each value In arrayList
            Set coll = dictTemp(value)
            For Each item In coll
                dict.Add item, value
            Next item
        Next value
        
        Set arrayList = Nothing
        
        ' Return the new dictionary
        Set SortDictionaryByValue = dict
            
    Done:
        Exit Function
    eh:
        If Err.Number = 450 Then
            Err.Raise vbObjectError + 100, "SortDictionaryByValue" _
                    , "Cannot sort the dictionary if the value is an object"
        End If
    End Function
    
    
    Public Function SortDictionaryByKey(dict As Object _
                      , Optional sortorder As XlSortOrder = xlAscending) As Object
        
        Dim arrList As Object
        Set arrList = CreateObject("System.Collections.ArrayList")
        
        ' Put keys in an ArrayList
        Dim key As Variant, coll As New Collection
        For Each key In dict
            arrList.Add key
        Next key
        
        ' Sort the keys
        arrList.Sort
        
        ' For descending order, reverse
        If sortorder = xlDescending Then
            arrList.Reverse
        End If
        
        ' Create new dictionary
        Dim dictNew As Object
        Set dictNew = CreateObject("Scripting.Dictionary")
        
        ' Read through the sorted keys and add to new dictionary
        For Each key In arrList
            dictNew.Add key, dict(key)
        Next key
        
        ' Clean up
        Set arrList = Nothing
        Set dict = Nothing
        
        ' Return the new dictionary
        Set SortDictionaryByKey = dictNew
            
    End Function

  2. #2
    Board Regular Leith Ross's Avatar
    Join Date
    Mar 2008
    Location
    San Francisco, CA
    Posts
    1,647
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    Hello bradyboyy88,

    When making calls to procdures in the Worksheet Open event, you need to fully qualify your references with the module name before the procdure name. For example, say that the SetIcon procedure is in Module1. Your code would then be: Call Module1.SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0). Do this for each procedure call in the Open event and it should work just fine.
    Last edited by Leith Ross; May 17th, 2018 at 01:46 PM.
    Sincerely,
    Leith Ross

  3. #3
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    Quote Originally Posted by Leith Ross View Post
    Hello bradyboyy88,

    When making calls to procdures in the Worksheet Open event, you need to fully qualify your references with the module name before the procdure name. For example, say that the SetIcon procedure is in Module1. Your code would then be: Call Module1.SetIcon(ThisWorkbook.Path & "\Images\LOGO.ico", 0). Do this for each procedure call in the Open event and it should work just fine.
    How come it only does this off and on and works sometimes? Its so strange lol.

  4. #4
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    I still got the error even when i tabbed out those module references. I think it may be the getsystemmetrics function. If i get the error again I am going to tab that out as well to see if it causes it.

  5. #5
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    10,226
    Post Thanks / Like
    Mentioned
    194 Post(s)
    Tagged
    10 Thread(s)

    Default Re: Weird excel error

    In the VBE goto Tools > Options > General > select Break In Class Module > OK.
    That may help in finding the problem.
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes

    Running Office 2003 & 2013 on Win 7

  6. #6
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    31,598
    Post Thanks / Like
    Mentioned
    14 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Weird excel error

    It would help to post all the API declarations. I notice that you have not declared the GetWindowLong, SetWindowLong, DrawMenuBar or FindWindowA functions as both 32 and 64 bit compatible.

  7. #7
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    I have 3 modules with API calls as shown below. I am going to try the error break idea you mentioned next time i get the error. I will say I am working under 32bit if that helps. The issue truly goes in this order. Open excel file and a few seconds later it crashes with system not responding and never even loads fully. Then I rename it so that it and dont enable macros. Then I save it . Then I will reopen and I will get the file not found error. Sounds crazy but thats typically what happens. Its a pretty big program but its on load where I get my error basically and the file not found error points to the workbook_open.

    Code:
    Option Explicit
    Option Compare Text
    
    
    'Modify window Controls
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWnd1 As Long, _
        ByVal hWnd2 As Long, _
        ByVal lpsz1 As String, _
        ByVal lpsz2 As String) As Long
    
    
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
        ByVal hWnd As Long, _
        ByVal lpString As String, _
        ByVal cch As Long) As Long
    
    
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal HKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
        
    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal HKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        LPType As Long, _
        LPData As Any, _
        lpcbData As Long) As Long
    
    
    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal HKey As Long) As Long
    
    
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
        ByVal hWnd As Long, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long
    
    
    Private Const HKEY_CURRENT_USER As Long = &H80000001
    Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
    Private Const HKEY_CLASSES_ROOT  As Long = &H80000000
    Private Const HKEY_CURRENT_CONFIG  As Long = &H80000005
    Private Const HKEY_DYN_DATA  As Long = &H80000006
    Private Const HKEY_PERFORMANCE_DATA  As Long = &H80000004
    Private Const HKEY_USERS  As Long = &H80000003
    Private Const KEY_ALL_ACCESS  As Long = &H3F
    Private Const ERROR_SUCCESS  As Long = 0&
    Private Const HKCU  As Long = HKEY_CURRENT_USER
    Private Const HKLM  As Long = HKEY_LOCAL_MACHINE
    
    
    Private Const C_USERFORM_CLASSNAME = "ThunderDFrame"
    Private Const C_EXCEL_APP_CLASSNAME = "XLMain"
    Private Const C_EXCEL_DESK_CLASSNAME = "XLDesk"
    Private Const C_EXCEL_WINDOW_CLASSNAME = "Excel7"
    Private Const MF_BYPOSITION = &H400
    Private Const MF_REMOVE = &H1000
    Private Const MF_ENABLED = &H0&
    Private Const MF_DISABLED = &H2&
    Private Const MF_GRAYED = &H1&
    Private Const GWL_EXSTYLE = (-20)
    Private Const GWL_STYLE = (-16)
    Private Const GWL_HWNDPARENT = (-8)
    Private Const WS_CAPTION = &HC00000
    Private Const WS_SYSMENU = &H80000
    Private Const WS_EX_LAYERED = &H80000
    Private Const LWA_ALPHA = &H2&
    Private Const C_ALPHA_FULL_TRANSPARENT As Byte = 0
    Private Const C_ALPHA_FULL_OPAQUE As Byte = 255
    Private Const WS_DLGFRAME = &H400000
    Private Const WS_THICKFRAME = &H40000
    Private Const WS_SIZEBOX = WS_THICKFRAME
    Private Const WS_MAXIMIZEBOX = &H10000
    Private Const WS_MINIMIZEBOX = &H20000
    
    
    
    
    Private Enum REG_DATA_TYPE
        REG_DATA_TYPE_DEFAULT = 0   ' Default based on data type of value.
        REG_INVALID = -1            ' Invalid
        REG_SZ = 1                  ' String
        REG_DWORD = 4               ' Long
    End Enum
    
    
    '--------------------------------------------------
    'Mod form declarations. Some are duplicate from window caption declarations
    Public Enum FORM_PARENT_WINDOW_TYPE
        FORM_PARENT_NONE = 0
        FORM_PARENT_APPLICATION = 1
        FORM_PARENT_WINDOW = 2
    End Enum
    
    
    Private Declare Function SetParent Lib "user32" ( _
        ByVal hWndChild As Long, _
        ByVal hWndNewParent As Long) As Long
    
    
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
        
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long) As Long
    
    
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
        
    Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal crey As Byte, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) As Long
    
    
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    
    
    Private Declare Function DrawMenuBar Lib "user32" ( _
        ByVal hWnd As Long) As Long
    
    
    Private Declare Function GetMenuItemCount Lib "user32" ( _
        ByVal hMenu As Long) As Long
    
    
    Private Declare Function GetSystemMenu Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal bRevert As Long) As Long
        
    Private Declare Function RemoveMenu Lib "user32" ( _
        ByVal hMenu As Long, _
        ByVal nPosition As Long, _
        ByVal wFlags As Long) As Long
        
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
        ByVal hWnd As Long) As Long
    
    
    Private Declare Function EnableMenuItem Lib "user32" ( _
        ByVal hMenu As Long, _
        ByVal wIDEnableItem As Long, _
        ByVal wEnable As Long) As Long
    '-----------------------------------------------------
    'Create Icon API , API CALLS
    Private Declare Function SetWindowPos Lib "user32" _
                                          (ByVal hWnd As Long, _
                                           ByVal hWndInsertAfter As Long, _
                                           ByVal X As Long, _
                                           ByVal Y As Long, _
                                           ByVal cx As Long, _
                                           ByVal cy As Long, _
                                           ByVal wFlags As Long) As Long
                                           
    Private Declare Function SendMessage Lib "user32" _
                                         Alias "SendMessageA" _
                                         (ByVal hWnd As Long, _
                                          ByVal wMsg As Long, _
                                          ByVal wParam As Long, _
                                          lParam As Any) As Long
    'Create Icon API COnstants
    Private Const SWP_NOMOVE = &H2
    Private Const SWP_NOSIZE = &H1
    Private Const HWND_TOP = 0
    Private Const SWP_NOACTIVATE = &H10
    Private Const SWP_HIDEWINDOW = &H80
    Private Const SWP_SHOWWINDOW = &H40
    Private Const WS_EX_APPWINDOW = &H40000
    Private Const SWP_FRAMECHANGED = &H20
    Private Const WM_SETICON = &H80
    Private Const ICON_SMALL = 0&
    Private Const ICON_BIG = 1&
                                           
    '----------------------------------------------
    
    
    'Clipboard API and COnstant Calls
    'Handle 64-bit and 32-bit Office
    #If  VBA7 Then
      Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
      Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
      Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
        ByVal dwBytes As LongPtr) As Long
      Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
      Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
      Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
        ByVal lpString2 As Any) As Long
      Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat _
        As LongPtr, ByVal hMem As LongPtr) As Long
    #Else 
      Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
        ByVal dwBytes As Long) As Long
      Declare Function CloseClipboard Lib "user32" () As Long
      Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Declare Function EmptyClipboard Lib "user32" () As Long
      Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
        ByVal lpString2 As Any) As Long
      Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
        As Long, ByVal hMem As Long) As Long
    #End  If
    
    
    Public Const GHND = &H42
    Public Const CF_TEXT = 1
    Public Const MAXSIZE = 4096
    '------------------------------------
    Function DoesWindowsHideFileExtensions() As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DoesWindowsHideFileExtensions
    ' This function looks in the registry key
    '   HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced
    ' for the value named "HideFileExt" to determine whether the Windows Explorer
    ' setting "Hide Extensions Of Known File Types" is enabled. This function returns
    ' TRUE if this setting is in effect (meaning that Windows displays "Book1" rather
    ' than "Book1.xls"), or FALSE if this setting is not in effect (meaning that Windows
    ' displays "Book1.xls").
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim Res As Long
    Dim RegKey As Long
    Dim V As Long
    
    
    Const KEY_NAME = "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
    Const VALUE_NAME = "HideFileExt"
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Open the registry key to get a handle (RegKey).
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    Res = RegOpenKeyEx(HKey:=HKCU, _
                        lpSubKey:=KEY_NAME, _
                        ulOptions:=0&, _
                        samDesired:=KEY_ALL_ACCESS, _
                        phkResult:=RegKey)
    
    
    If Res <> ERROR_SUCCESS Then
        Exit Function
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get the value of the "HideFileExt" named value.
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    Res = RegQueryValueEx(HKey:=RegKey, _
                        lpValueName:=VALUE_NAME, _
                        lpReserved:=0&, _
                        LPType:=REG_DWORD, _
                        LPData:=V, _
                        lpcbData:=Len(V))
    
    
    If Res <> ERROR_SUCCESS Then
        RegCloseKey RegKey
        Exit Function
    End If
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Close the key and return the result.
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    RegCloseKey RegKey
    DoesWindowsHideFileExtensions = (V <> 0)
    
    
    
    
    End Function
    
    
    
    
    Function WindowCaption(W As Excel.Window) As String
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' WindowCaption
    ' This returns the Caption of the Excel.Window W with the ".xls" extension removed
    ' if required. The string returned by this function is suitable for use by
    ' the FindWindowEx API regardless of the value of the Windows "Hide Extensions"
    ' setting.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim HideExt As Boolean
    Dim Cap As String
    Dim Pos As Long
    
    
    HideExt = DoesWindowsHideFileExtensions()
    Cap = W.Caption
    If HideExt = True Then
        Pos = InStrRev(Cap, ".")
        If Pos > 0 Then
            Cap = Left(Cap, Pos - 1)
        End If
    End If
    
    
    WindowCaption = Cap
    
    
    End Function
    
    
    Function WindowHWnd(W As Excel.Window) As Long
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' WindowHWnd
    ' This returns the HWnd of the Window referenced by W.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim AppHWnd As Long
    Dim DeskHWnd As Long
    Dim WHWnd As Long
    Dim Cap As String
    
    
    AppHWnd = Application.hWnd
    DeskHWnd = FindWindowEx(AppHWnd, 0&, C_EXCEL_DESK_CLASSNAME, vbNullString)
    If DeskHWnd > 0 Then
        Cap = WindowCaption(W)
        WHWnd = FindWindowEx(DeskHWnd, 0&, C_EXCEL_WINDOW_CLASSNAME, Cap)
    End If
    WindowHWnd = WHWnd
    
    
    End Function
    
    
    Function WindowText(hWnd As Long) As String
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' WindowText
    ' This just wraps up GetWindowText.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim S As String
        Dim n As Long
        n = 255
        S = String$(n, vbNullChar)
        n = GetWindowText(hWnd, S, n)
        If n > 0 Then
            WindowText = Left(S, n)
        Else
            WindowText = vbNullString
        End If
    End Function
    
    
    Function WindowClassName(hWnd As Long) As String
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' WindowClassName
    ' This just wraps up GetClassName.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        Dim S As String
        Dim n As Long
        n = 255
        S = String$(n, vbNullChar)
        n = GetClassName(hWnd, S, n)
        If n > 0 Then
            WindowClassName = Left(S, n)
        Else
            WindowClassName = vbNullString
        End If
    
    
    End Function
    
    
    'Mod window caption
    Function ShowMaximizeButton(UF As MSForms.UserForm, _
        HideButton As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ShowMaximizeButton
    ' Displays (if HideButton is False) or hides (if HideButton is True)
    ' a maximize window button.
    ' NOTE: If EITHER a Minimize or Maximize button is displayed,
    ' BOTH buttons are visible but may be disabled.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        ShowMaximizeButton = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    If HideButton = False Then
        WinInfo = WinInfo Or WS_MAXIMIZEBOX
    Else
        WinInfo = WinInfo And (Not WS_MAXIMIZEBOX)
    End If
    R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
    
    
    ShowMaximizeButton = (R <> 0)
    
    
    End Function
    
    
    Function ShowMinimizeButton(UF As MSForms.UserForm, _
        HideButton As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ShowMinimizeButton
    ' Displays (if HideButton is False) or hides (if HideButton is True)
    ' a minimize window button.
    ' NOTE: If EITHER a Minimize or Maximize button is displayed,
    ' BOTH buttons are visible but may be disabled.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        ShowMinimizeButton = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    If HideButton = False Then
        WinInfo = WinInfo Or WS_MINIMIZEBOX
    Else
        WinInfo = WinInfo And (Not WS_MINIMIZEBOX)
    End If
    R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
    
    
    ShowMinimizeButton = (R <> 0)
    
    
    End Function
    
    
    Function HasMinimizeButton(UF As MSForms.UserForm) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' HasMinimizeButton
    ' Returns True if the userform has a minimize button, False
    ' otherwise.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        HasMinimizeButton = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    
    
    If WinInfo And WS_MINIMIZEBOX Then
        HasMinimizeButton = True
    Else
        HasMinimizeButton = False
    End If
    
    
    End Function
    
    
    Function HasMaximizeButton(UF As MSForms.UserForm) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' HasMaximizeButton
    ' Returns True if the userform has a maximize button, False
    ' otherwise.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        HasMaximizeButton = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    
    
    If WinInfo And WS_MAXIMIZEBOX Then
        HasMaximizeButton = True
    Else
        HasMaximizeButton = False
    End If
    
    
    End Function
    
    
    
    
    Function SetFormParent(UF As MSForms.UserForm, _
        Parent As FORM_PARENT_WINDOW_TYPE) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetFormParent
    ' Set the UserForm UF as a child of (1) the Application, (2) the
    ' Excel ActiveWindow, or (3) no parent. Returns TRUE if successful
    ' or FALSE if unsuccessful.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WindHWnd As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        SetFormParent = False
        Exit Function
    End If
    
    
    Select Case Parent
        Case FORM_PARENT_APPLICATION
            R = SetParent(UFHWnd, Application.hWnd)
        Case FORM_PARENT_NONE
            R = SetParent(UFHWnd, 0&)
        Case FORM_PARENT_WINDOW
            If Application.ActiveWindow Is Nothing Then
                SetFormParent = False
                Exit Function
            End If
            WindHWnd = WindowHWnd(Application.ActiveWindow)
            If WindHWnd = 0 Then
                SetFormParent = False
                Exit Function
            End If
            R = SetParent(UFHWnd, WindHWnd)
        Case Else
            SetFormParent = False
            Exit Function
    End Select
    SetFormParent = (R <> 0)
    
    
    End Function
    
    
    
    
    Function IsCloseButtonVisible(UF As MSForms.UserForm) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' IsCloseButtonVisible
    ' Returns TRUE if UserForm UF has a close button, FALSE if there
    ' is no close button.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        IsCloseButtonVisible = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    IsCloseButtonVisible = (WinInfo And WS_SYSMENU)
    
    
    End Function
    
    
    Function ShowCloseButton(UF As MSForms.UserForm, HideButton As Boolean) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ShowCloseButton
    ' This displays (if HideButton is FALSE) or hides (if HideButton is
    ' TRUE) the Close button on the userform
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    If HideButton = False Then
        ' set the SysMenu bit
        WinInfo = WinInfo Or WS_SYSMENU
    Else
        ' clear the SysMenu bit
        WinInfo = WinInfo And (Not WS_SYSMENU)
    End If
    
    
    R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
    ShowCloseButton = (R <> 0)
    
    
    End Function
    
    
    
    
    Function IsCloseButtonEnabled(UF As MSForms.UserForm) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' IsCloseButtonEnabled
    ' This returns TRUE if the close button is enabled or FALSE if
    ' the close button is disabled.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim hMenu As Long
    Dim ItemCount As Long
    Dim PrevState As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        IsCloseButtonEnabled = False
        Exit Function
    End If
    ' Get the menu handle
    hMenu = GetSystemMenu(UFHWnd, 0&)
    If hMenu = 0 Then
        IsCloseButtonEnabled = False
        Exit Function
    End If
    
    
    ItemCount = GetMenuItemCount(hMenu)
    ' Disable the button. This returns MF_DISABLED or MF_ENABLED indicating
    ' the previous state of the item.
    PrevState = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)
    
    
    If PrevState = MF_DISABLED Then
        IsCloseButtonEnabled = False
    Else
        IsCloseButtonEnabled = True
    End If
    ' restore the previous state
    EnableCloseButton UF, (PrevState = MF_DISABLED)
    
    
    DrawMenuBar UFHWnd
    
    
    End Function
    
    
    
    
    Function EnableCloseButton(UF As MSForms.UserForm, Disable As Boolean) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' EnableCloseButton
    ' This function enables (if Disable is False) or disables (if
    ' Disable is True) the "X" button on a UserForm UF.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim hMenu As Long
    Dim ItemCount As Long
    Dim Res As Long
    
    
    ' Get the HWnd of the UserForm.
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        EnableCloseButton = False
        Exit Function
    End If
    ' Get the menu handle
    hMenu = GetSystemMenu(UFHWnd, 0&)
    If hMenu = 0 Then
        EnableCloseButton = False
        Exit Function
    End If
    
    
    ItemCount = GetMenuItemCount(hMenu)
    If Disable = True Then
        Res = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)
    Else
        Res = EnableMenuItem(hMenu, ItemCount - 1, MF_ENABLED Or MF_BYPOSITION)
    End If
    If Res = -1 Then
        EnableCloseButton = False
        Exit Function
    End If
    DrawMenuBar UFHWnd
    
    
    EnableCloseButton = True
    
    
    
    
    End Function
    
    
    Function ShowTitleBar(UF As MSForms.UserForm, HideTitle As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ShowTitleBar
    ' Displays (if HideTitle is FALSE) or hides (if HideTitle is TRUE) the
    ' title bar of the userform UF.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        ShowTitleBar = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    
    
    If HideTitle = False Then
        ' turn on the Caption bit
        WinInfo = WinInfo Or WS_CAPTION
    Else
        ' turn off the Caption bit
        WinInfo = WinInfo And (Not WS_CAPTION)
    End If
    R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
    ShowTitleBar = (R <> 0)
    End Function
    
    
    Function IsTitleBarVisible(UF As MSForms.UserForm) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' IsTitleBarVisible
    ' Returns TRUE if the title bar of UF is visible or FALSE if the
    ' title bar is not visible.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        IsTitleBarVisible = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    
    
    IsTitleBarVisible = (WinInfo And WS_CAPTION)
    
    
    End Function
    
    
    Function MakeFormResizable(UF As MSForms.UserForm, Sizable As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' MakeFormResizable
    ' This makes the userform UF resizable (if Sizable is TRUE) or not
    ' resizable (if Sizalbe is FALSE). Returns TRUE if successful or FALSE
    ' if an error occurred.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        MakeFormResizable = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    If Sizable = True Then
        WinInfo = WinInfo Or WS_SIZEBOX
    Else
        WinInfo = WinInfo And (Not WS_SIZEBOX)
    End If
    
    
    R = SetWindowLong(UFHWnd, GWL_STYLE, WinInfo)
    MakeFormResizable = (R <> 0)
    
    
    
    
    End Function
    
    
    Function IsFormResizable(UF As MSForms.UserForm) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' IsFormResizable
    ' Returns TRUE if UF is resizable, FALSE if UF is not resizable.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim UFHWnd As Long
    Dim WinInfo As Long
    Dim R As Long
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        IsFormResizable = False
        Exit Function
    End If
    
    
    WinInfo = GetWindowLong(UFHWnd, GWL_STYLE)
    
    
    IsFormResizable = (WinInfo And WS_SIZEBOX)
    
    
    End Function
    
    
    
    
    Function SetFormOpacity(UF As MSForms.UserForm, Opacity As Byte) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetFormOpacity
    ' This function sets the opacity of the UserForm referenced by the
    ' UF parameter. Opacity specifies the opacity of the form, from
    ' 0 = fully transparent (invisible) to 255 = fully opaque. The function
    ' returns True if successful or False if an error occurred. This
    ' requires Windows 2000 or later -- it will not work in Windows
    ' 95, 98, or ME.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim UFHWnd As Long
    Dim WinL As Long
    Dim Res As Long
    
    
    SetFormOpacity = False
    
    
    UFHWnd = HWndOfUserForm(UF)
    If UFHWnd = 0 Then
        Exit Function
    End If
    
    
    WinL = GetWindowLong(UFHWnd, GWL_EXSTYLE)
    If WinL = 0 Then
        Exit Function
    End If
    
    
    Res = SetWindowLong(UFHWnd, GWL_EXSTYLE, WinL Or WS_EX_LAYERED)
    If Res = 0 Then
        Exit Function
    End If
    
    
    Res = SetLayeredWindowAttributes(UFHWnd, 0, Opacity, LWA_ALPHA)
    If Res = 0 Then
        Exit Function
    End If
    
    
    SetFormOpacity = True
    
    
    End Function
    
    
    
    
    Function HWndOfUserForm(UF As MSForms.UserForm) As Long
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' HWndOfUserForm
    ' This returns the window handle (HWnd) of the userform referenced
    ' by UF. It first looks for a top-level window, then a child
    ' of the Application window, then a child of the ActiveWindow.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim AppHWnd As Long
    Dim DeskHWnd As Long
    Dim WinHWnd As Long
    Dim UFHWnd As Long
    Dim Cap As String
    Dim WindowCap As String
    
    
    Cap = UF.Caption
    
    
    ' First, look in top level windows
    UFHWnd = FindWindow(C_USERFORM_CLASSNAME, Cap)
    If UFHWnd <> 0 Then
        HWndOfUserForm = UFHWnd
        Exit Function
    End If
    ' Not a top level window. Search for child of application.
    AppHWnd = Application.hWnd
    UFHWnd = FindWindowEx(AppHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
    If UFHWnd <> 0 Then
        HWndOfUserForm = UFHWnd
        Exit Function
    End If
    ' Not a child of the application.
    ' Search for child of ActiveWindow (Excel's ActiveWindow, not
    ' Window's ActiveWindow).
    If Application.ActiveWindow Is Nothing Then
        HWndOfUserForm = 0
        Exit Function
    End If
    WinHWnd = WindowHWnd(Application.ActiveWindow)
    UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
    HWndOfUserForm = UFHWnd
    
    
    End Function
    
    
    
    
    Function ClearBit(value As Long, ByVal BitNumber As Long) As Long
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ClearBit
    ' Clears the specified bit in Value and returns the result. Bits are
    ' numbered, right (most significant) 31 to left (least significant) 0.
    ' BitNumber is made positive and then MOD 32 to get a valid bit number.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    Dim SetMask As Long
    Dim ClearMask As Long
    
    
    BitNumber = Abs(BitNumber) Mod 32
    
    
    SetMask = value
    If BitNumber < 30 Then
        ClearMask = Not (2 ^ (BitNumber - 1))
        ClearBit = SetMask And ClearMask
    Else
        ClearBit = value And &H7FFFFFFF
    End If
    
    
    End Function
    
    
    'CreateIconAPI
    Public Sub AppTasklist(myForm)
    
    
    'Add this userform into the Task bar
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long
        hWnd = FindWindow(vbNullString, myForm.Caption)
        WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
        WStyle = WStyle Or WS_EX_APPWINDOW
        Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                              SWP_NOMOVE Or _
                              SWP_NOSIZE Or _
                              SWP_NOACTIVATE Or _
                              SWP_HIDEWINDOW)
        Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
        Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                              SWP_NOMOVE Or _
                              SWP_NOSIZE Or _
                              SWP_NOACTIVATE Or _
                              SWP_SHOWWINDOW)
    
    
    End Sub
    
    
    Sub AppTaskDelist(myForm)
        'remove this userform from the Task bar
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long
         
        hWnd = FindWindow(vbNullString, myForm.Caption)
        WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
        WStyle = WStyle And Not WS_EX_APPWINDOW
        Result = SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
        SWP_NOMOVE Or _
        SWP_NOSIZE Or _
        SWP_NOACTIVATE Or _
        SWP_HIDEWINDOW)
        Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
        Result = SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
        SWP_NOMOVE Or _
        SWP_NOSIZE Or _
        SWP_NOACTIVATE Or _
        SWP_SHOWWINDOW)
    End Sub
    
    
    'Clipboard FUnctions
    Function ClipBoard_SetData(MyString As String)
    'PURPOSE: API function to copy text to clipboard
    'SOURCE: http://www.msdn.microsoft.com/en-us/.../ff192913.aspx
    
    
    Dim hGlobalMemory As Long, lpGlobalMemory As Long
    Dim hClipMemory As Long, X As Long
    
    
    'Allocate moveable global memory
      hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
    
    
    'Lock the block to get a far pointer to this memory.
      lpGlobalMemory = GlobalLock(hGlobalMemory)
    
    
    'Copy the string to this global memory.
      lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
    
    
    'Unlock the memory.
      If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Could not unlock memory location. Copy aborted."
        GoTo OutOfHere2
      End If
    
    
    'Open the Clipboard to copy data to.
      If OpenClipboard(0&) = 0 Then
        MsgBox "Could not open the Clipboard. Copy aborted."
        Exit Function
      End If
    
    
    'Clear the Clipboard.
      X = EmptyClipboard()
    
    
    'Copy the data to the Clipboard.
      hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    
    
    OutOfHere2:
      If CloseClipboard() = 0 Then
        MsgBox "Could not close Clipboard."
      End If
    
    
    End Function
    
    
    Sub CopyTextToClipboard()
    'PURPOSE: Copy a given text to the clipboard (using Windows API)
    'SOURCE: www.TheSpreadsheetGuru.com
    'NOTES: Must have above API declaration and ClipBoard_SetData function in your code
    
    
    Dim txt As String
    
    
    'Put some text inside a string variable
      txt = "This was copied to the clipboard using VBA!"
    
    
    'Place text into the Clipboard
       ClipBoard_SetData txt
    
    
    'Notify User
      MsgBox "There is now text copied to your clipboard!", vbInformation
    
    
    End Sub
    Code:
    Option Explicit
    '--------------------------------Create Icons Variable Declarations (API Mainly)----------------------------------'
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' modSetIcon
    ' This module contains code to change the icon of the Excel main
    ' window. The code is compatible with 64-bit Office.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If  VBA7 And Win64 Then
    '''''''''''''''''''''''''''''
    ' 64 bit Excel
    '''''''''''''''''''''''''''''
    Private Declare PtrSafe Function SendMessageA Lib "user32" _
          (ByVal hWnd As LongPtr, _
          ByVal wMsg As LongPtr, _
          ByVal wParam As LongPtr, _
          ByVal lParam As LongPtr) As LongPtr
    
    
    Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
          (ByVal hInst As LongPtr, _
          ByVal lpszExeFileName As String, _
          ByVal nIconIndex As LongPtr) As Long
    
    
    Private Const ICON_SMALL = 0&
    Private Const ICON_BIG = 1&
    Private Const WM_SETICON = &H80
    
    
    #Else 
    '''''''''''''''''''''''''''''
    ' 32 bit Excel
    '''''''''''''''''''''''''''''
    Private Declare Function SendMessageA Lib "user32" _
          (ByVal hWnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Integer, _
          ByVal lParam As Long) As Long
    
    
    Private Declare Function ExtractIconA Lib "shell32.dll" _
          (ByVal hInst As Long, _
          ByVal lpszExeFileName As String, _
          ByVal nIconIndex As Long) As Long
    
    
    Private Const ICON_SMALL As Long = 0&
    Private Const ICON_BIG As Long = 1&
    Private Const WM_SETICON As Long = &H80
    #End  If
    
    
    '-------------Lightbox userform windowframe removal Variable Declariations (API Mainly)----------------------------'
    'All Windows API variables that must be declared via module and not class module
    'Hide userform window frames. Used in class module HideTitleBar
    Public Const GWL_STYLE = -16
    Public Const WS_CAPTION = &HC00000
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    Public Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hWnd As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    
    '------------------------------Open file API Calls--------------------------------------------'
    #If  VBA7 And Win64 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
      ByVal lpOperation As String, ByVal lpFile As String, _
      ByVal lpParameters As String, ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long
    #Else 
    Private Declare Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
      ByVal lpOperation As String, ByVal lpFile As String, _
      ByVal lpParameters As String, ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long
    #End  If
    
    
    
    
    '--------------------------------Create Icons--------------------------------------------------'
    Sub SetIcon(FileName As String, Optional index As Long = 0)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetIcon
    ' This procedure sets the icon in the upper left corner of
    ' the main Excel window. FileName is the name of the file
    ' containing the icon. It may be an .ico file, an .exe file,
    ' or a .dll file. If it is an .ico file, Index must be 0
    ' or omitted. If it is an .exe or .dll file, Index is the
    ' 0-based index to the icon resource.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If  VBA7 And Win64 Then
        ' 64 bit Excel
        Dim hWnd As LongPtr
        Dim HIcon As LongPtr
    #Else 
        ' 32 bit Excel
        Dim hWnd As Long
        Dim HIcon As Long
    #End  If
        Dim n As Long
        Dim S As String
        If Dir(FileName, vbNormal) = vbNullString Then
            ' file not found, get out
            Exit Sub
        End If
        ' get the extension of the file.
        n = InStrRev(FileName, ".")
        S = LCase(Mid(FileName, n + 1))
        ' ensure we have a valid file type
        Select Case S
            Case "exe", "ico", "dll"
                ' OK
            Case Else
                ' invalid file type
                Err.Raise 5
        End Select
        hWnd = Application.hWnd
        If hWnd = 0 Then
            Exit Sub
        End If
        HIcon = ExtractIconA(0, FileName, index)
        If HIcon <> 0 Then
            SendMessageA hWnd, WM_SETICON, ICON_SMALL, HIcon
        End If
    End Sub
    
    
    
    
    '------------------------Lightbox userform windowframe removal-----------------------------'
    Sub HideTitleBar(frm As Object)
    
    
        Dim lngWindow As Long
        Dim lFrmHdl As Long
        lFrmHdl = FindWindowA(vbNullString, frm.Caption)
        lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
        lngWindow = lngWindow And (Not WS_CAPTION)
        Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
        Call DrawMenuBar(lFrmHdl)
        
    End Sub
    
    
    '------------------------Allow user to return single file from filedialog-------------------------'
    
    
    Function SingleFilePath()
    
    
    Dim intChoice As Integer
    Dim strPath As String
    
    
    'only allow the user to select one file
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    
    'determine what choice the user made
    If intChoice <> 0 Then
        'get the file path selected by the user
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        'return the filepath
        SingleFilePath = strPath
    End If
    
    
    End Function
    
    
    '---------------------Allow user to return multiple files from filedialog---------------------'
    Function MultipleFilePath() As String()
    
    
    Dim intChoice As Integer
    Dim strPath() As String
    Dim i As Integer
    
    
    'allow the user to select multiple files
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    
    'determine what choice the user made
    If intChoice <> 0 Then
        'get the file path selected by the user
        For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.count
            strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)
        Next i
    End If
    
    
    MultipleFilePath = strPath
    
    
    End Function
    
    
    'Open files command
    
    
    Sub OpenFile(StringPath As String)
        If fso.GetExtensionName(StringPath) = "xls" Or fso.GetExtensionName(StringPath) = "xlsm" _
            Or fso.GetExtensionName(StringPath) = "xlsx" Then
        
            Dim xlApp As Application
            Set xlApp = CreateObject("Excel.Application")
            Application.DisplayAlerts = False
            xlApp.Workbooks.Open StringPath, , True
            Application.DisplayAlerts = True
            xlApp.Visible = True
            Set xlApp = Nothing
             
        ElseIf fso.GetExtensionName(StringPath) = "doc" Or fso.GetExtensionName(StringPath) = "pdf" _
            Or fso.GetExtensionName(StringPath) = "txt" Then
        
            Dim Result As Long
            Result = ShellExecute(0&, vbNullString, StringPath, _
            vbNullString, vbNullString, vbNormalFocus)
            If Result < 32 Then MsgBox "Error"
            
       Else
       
            Dim objShell As Object
            Set objShell = CreateObject("Shell.Application")
            Application.DisplayAlerts = False
            objShell.Open (StringPath)
            Application.DisplayAlerts = True
            Set objShell = Nothing
            
        End If
    End Sub
    
    
    'Copy files without waiting for file transfer to resume code
    Sub FileCopyImproved(sSourceFile As String, sDestFile As String)
        
        'Asynch File Copy
        Shell Environ$("comspec") & " /c xcopy /y """ & sSourceFile & """ """ & sDestFile & "*" & """ ", vbHide
        
    End Sub
    
    
    
    
    Function CorrectMMCIDFormat(MMCIDEntered As String)
    
    
    'Check Formatting of MMCID Entered
            If Len(MMCIDEntered) = 11 Then
                
                RegEx.Pattern = "[A-Za-z]"
                If RegEx.Test(Left(MMCIDEntered, 2)) Then
                
                    RegEx.Pattern = "^[0-9]+$"
                    If RegEx.Test(Right(MMCIDEntered, 8)) Then
                        
                        If Mid(MMCIDEntered, 3, 1) = "-" Then
                        
                            
                            CorrectMMCIDFormat = True
                            
                        Else
                        
                            CorrectMMCIDFormat = False
                        
                        End If
                    
                    Else
                        
                        CorrectMMCIDFormat = False
                    
                    End If
                
                Else
                    
                    CorrectMMCIDFormat = False
                
                End If
            
            Else
                
                CorrectMMCIDFormat = False
            
            End If
    
    
    End Function
    
    
    Function stripEnclosed(strIn As String) As String
    'need to enable ms vbscript regular
    Dim re As VBScript_RegExp_55.RegExp, AllMatches As VBScript_RegExp_55.MatchCollection, M As VBScript_RegExp_55.Match
    Dim closeIndex As Long
    Dim tmpstr As String
    tmpstr = strIn
    Set re = New VBScript_RegExp_55.RegExp
    re.Global = True
    re.Pattern = "<[^/>]+>"
    Set AllMatches = re.Execute(tmpstr)
    For Each M In AllMatches
        closeIndex = InStr(tmpstr, Replace(M.value, "<", " 0 Then tmpstr = Left(tmpstr, InStr(tmpstr, M.value) - 1) & Mid(tmpstr, closeIndex + Len(M.value) + 1)
    Next M
    stripEnclosed = tmpstr
    End Function
    
    
    Public Function StripHTML(str As String) As String
    
    
    Dim RegEx As Object
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .Global = True
        .IgnoreCase = True
        .MultiLine = True
        .Pattern = "<[^>]+>"
    End With
    
    
    StripHTML = RegEx.Replace(str, "")
    Set RegEx = Nothing
    
    
    End Function
    
    
    Sub ProcessStepTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentStep As Integer
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim MaxOrdering As Integer
        Dim IsIterative As Boolean
        Dim CurrentOrder As Integer
        Dim CurrentRound As Integer
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.ROUND DESC,PRT.DATE_ENTERED DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        LastProcessStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        CurrentRound = ActiveRecordset.Fields("ROUND").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
    
    
        If LastProcessStep = MaxVersionStep Then
        
            If IsIterative Then
            
                SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                CurrentRound = CurrentRound + 1
                
            Else
            
                SQLQueryCode = "SELECT T3.NEXT_VERSION_NUMBER, T4.PROCESS_STEP_DISPLAY_TEXT FROM (SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON " & _
                                "(Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) WHERE BaseReview.MMCID = " & ActiveMMCID & " ) AS T1 " & _
                                " INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING ) AS T3 INNER JOIN Process_Ordering AS T4 ON T3.NEXT_VERSION_NUMBER=T4.PROCESS_SET_VERSION WHERE PROCESS_ID_NUMBER=1"
    
    
                
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                If ActiveRecordset.RecordCount = 0 Then
                
                    ProcessVersionTrackingVar = Null
                    ProcessConfirmationMessage = ""
                    
                Else
                
                    'Append basereview table for new version number
                    SQLQueryCode = "UPDATE BASEREVIEW" & _
                                   " SET PROCESS_ORDERING_SET_DD=" & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & _
                                   " WHERE MMCID=" & ActiveMMCID
                
                    Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                
                    'New version always has first step as 1
                    ProcessVersionTrackingVar = 1
                    CurrentRound = 1
                    CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                    ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                        
                End If
            
            End If
        
        Else
        
            ProcessVersionTrackingVar = LastProcessStep + 1
            
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            
        End If
    
    
        'Update Table
        If Not IsNull(ProcessVersionTrackingVar) Then
            
            'Jerry rig for fake DMCP entries for steps 9, 10, 11
            If (ProcessVersionTrackingVar = 9 Or ProcessVersionTrackingVar = 10 Or ProcessVersionTrackingVar = 11) And CurrentVersion = ProcessVersionQuestionSet Then
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
                ProcessVersionTrackingVar = ProcessVersionTrackingVar + 1
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            Else
                SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                            " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & CurrentVersion & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
                Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            End If
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Sub
    
    
    Sub ProcessVersionTracking(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean)
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentVersion As Integer
        Dim CurrentRound As Integer
        
        SQLQueryCode = "SELECT T2.PROCESS_VERSION_NUMBER AS NEXT_VERSION_NUMBER FROM ( SELECT BaseReview.MMCID, Process_Version_Ordering.ORDERING+1 AS ORDERING_PLUS_ONE, Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP, " & _
                        " Process_Version_Ordering.PROCESS_VERSION_NUMBER FROM Process_Version_Ordering INNER JOIN BaseReview ON (Process_Version_Ordering.LARGER_PROCESS_VERSION_GROUP = BaseReview.LARGER_PROCESS_VERSION_GROUP) AND (Process_Version_Ordering.PROCESS_VERSION_NUMBER = BaseReview.PROCESS_ORDERING_SET_DD) " & _
                        " WHERE BaseReview.MMCID = " & MMCID & " ) AS T1 INNER Join Process_Version_Ordering As T2 ON T1.LARGER_PROCESS_VERSION_GROUP=T2.LARGER_PROCESS_VERSION_GROUP WHERE T1.ORDERING_PLUS_ONE = T2.ORDERING"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        'Assume first step in process version is always 1
        ProcessVersionTrackingVar = 1
        CurrentRound = 1
        
        'Update Table
        If ActiveRecordset.RecordCount > 0 Then
            SQLQueryCode = "INSERT INTO Process_and_Review_Tracking (MMCID, ROUND, SENDER, SENDERS_ROLE, RECIPIENT_ROLE, PROCESS_VERSION, PROCESS_STEP, DATE_ENTERED)" & _
                           " VALUES (" & MMCID & "," & CurrentRound & "," & UserNumber & "," & SenderRole & "," & RecipientRole & "," & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & "," & ProcessVersionTrackingVar & ", FORMAT(#" & CDate(DateString) & "#,'MM/DD/YYYY HH:mm:ss'))"
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
            
            SQLQueryCode = "UPDATE BASEREVIEW SET PROCESS_ORDERING_SET_DD = " & ActiveRecordset.Fields("NEXT_VERSION_NUMBER").value & " WHERE MMCID= " & MMCID
            Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
    
    
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Sub
    
    
    Function NextStepButtonText(MMCID As Integer, SenderRole As Integer, RecipientRole As Integer, DateString As String, connectionOpen As Boolean) As String
    
    
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        Dim ProcessVersionTrackingVar As Integer
        Dim CurrentStep As Integer
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim MaxOrdering As Integer
        Dim IsIterative As Boolean
        Dim CurrentOrder As Integer
        Dim CurrentRound As Integer
        Dim ButtonText As String
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        LastProcessStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        CurrentRound = ActiveRecordset.Fields("ROUND").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
    
    
        If LastProcessStep = MaxVersionStep Then
        
            If IsIterative Then
            
                SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER>0 AND PO.PROCESS_SET_VERSION=" & CurrentVersion & " ORDER BY PO.PROCESS_ID_NUMBER ASC"
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                CurrentRound = CurrentRound + 1
                ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
                
            Else
            
                SQLQueryCode = "SELECT PROCESS_VERSION_NUMBER FROM PROCESS_VERSION_ORDERING WHERE ORDERING=" & CurrentOrder + 1
                Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            
                If IsNull(ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value) Then
                
                    ProcessVersionTrackingVar = Null
                    ProcessConfirmationMessage = ""
                    ButtonText = "Null"
                Else
                
                    SQLQueryCode = "SELECT PROCESS_ID_NUMBER, PROCESS_SET_VERSION,PROCESS_STEP_DISPLAY_TEXT,PROCESS_ACTION_BUTTON_TEXT FROM PROCESS_ORDERING WHERE PROCESS_SET_VERSION=" & ActiveRecordset.Fields("PROCESS_VERSION_NUMBER").value & " AND PROCESS_ID_NUMBER>0 ORDER BY PROCESS_ID_NUMBER ASC"
                    Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
                    ProcessVersionTrackingVar = ActiveRecordset.Fields("PROCESS_ID_NUMBER").value
                    CurrentVersion = ActiveRecordset.Fields("PROCESS_SET_VERSION").value
                    ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
                    ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
    
    
                End If
            
            End If
        
        Else
        
            ProcessVersionTrackingVar = LastProcessStep + 1
            
            SQLQueryCode = "SELECT PO.PROCESS_ID_NUMBER,PO.PROCESS_STEP_DISPLAY_TEXT,PO.PROCESS_ACTION_BUTTON_TEXT FROM Process_Ordering AS PO WHERE PO.PROCESS_ID_NUMBER=" & ProcessVersionTrackingVar & "  AND PO.PROCESS_SET_VERSION=" & CurrentVersion
            Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
            ProcessConfirmationMessage = ActiveRecordset.Fields("PROCESS_STEP_DISPLAY_TEXT").value
            ButtonText = ActiveRecordset.Fields("PROCESS_ACTION_BUTTON_TEXT").value
            
        End If
    
    
        'Update Table
        NextStepButtonText = ButtonText
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
        
    End Function
    
    
    Function IsMaxProcessStep(MMCID As Integer, CheckIterative As Boolean, connectionOpen As Boolean)
    
    
        Dim LastStep As Integer
        Dim CurrentVersion As Integer
        Dim MaxVersionStep As Integer
        Dim CurrentOrder As Integer
        Dim IsIterative As Boolean
        
        If connectionOpen Then
            DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        End If
        
        SQLQueryCode = "SELECT PRT.PROCESS_VERSION, PRT.PROCESS_STEP,PRT.ROUND, PRT.DATE_ENTERED " & _
                       "FROM (PROCESS_AND_REVIEW_TRACKING PRT INNER JOIN BASEREVIEW BR " & _
                       "ON BR.PROCESS_ORDERING_SET_DD=PRT.PROCESS_VERSION AND PRT.MMCID=BR.MMCID) " & _
                       "WHERE PRT.MMCID= " & MMCID & " ORDER BY PRT.DATE_ENTERED DESC, PRT.ROUND DESC, PRT.PROCESS_STEP DESC"
    
    
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
        LastStep = ActiveRecordset.Fields("Process_Step").value
        CurrentVersion = ActiveRecordset.Fields("PROCESS_VERSION").value
        
        SQLQueryCode = "SELECT PO.MAXSTEP, PVO.ORDERING, PV.ITERABLE " & _
                       "FROM ((SELECT MAX(PROCESS_ID_NUMBER) AS MAXSTEP, PROCESS_SET_VERSION FROM Process_Ordering WHERE PROCESS_SET_VERSION=" & CurrentVersion & " GROUP BY PROCESS_SET_VERSION) AS PO INNER JOIN PROCESS_VERSION_ORDERING AS PVO ON PO.PROCESS_SET_VERSION=PVO.PROCESS_VERSION_NUMBER) " & _
                       "INNER JOIN PROCESS_VERSIONS AS PV ON PO.PROCESS_SET_VERSION=PV.VERSION_NUMBER "
        
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
        
        MaxVersionStep = ActiveRecordset.Fields("MAXSTEP").value
        CurrentOrder = ActiveRecordset.Fields("ORDERING").value
        IsIterative = ActiveRecordset.Fields("ITERABLE").value
        
        If CheckIterative = True Then
            If LastStep = MaxVersionStep And IsIterative = True Then
                IsMaxProcessStep = True
            Else
                IsMaxProcessStep = False
            End If
        Else
            If LastStep = MaxVersionStep Then
                IsMaxProcessStep = True
            Else
                IsMaxProcessStep = False
            End If
        End If
        
        If connectionOpen Then
            DatabaseMethods.SQLCloseDatabaseConnection
        End If
    
    
    End Function
    
    
    'This is for the update of the validating documents. Since the dynamic button class cant access forms subroutines we have to put it here
    Sub ActivateValidateDocs(DocumentToValidate As String)
         
        DocumentValidated = DocumentToValidate
        'Clear old Contents
        MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc.Clear
    
    
        'ACTIVATE THE SCREEN!
        With MMCARMS.MMCIDMainBlurrImage
            .Width = MMCARMS.Width
            .Height = MMCARMS.Height
            .Top = 0
            .Left = 0
            .Visible = True
            .ZOrder (0)
        End With
        
        With MMCARMS.ValidateDocFrame
            .Height = 204
            .Width = 354
            .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
            .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height) - 10
            .Visible = True
            .ZOrder (0)
        End With
    
    
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
    
    
        'Find definitions to fill dropdown box
        SQLQueryCode = "SELECT DTT.DOC_TYPE_DESCRIPTION,DTT.DOC_TYPE_DD,DTT.DOC_GROUP_TYPE_DD FROM DOCUMENTATION_TYPE_TAB DTT WHERE DTT.DOC_GROUP_TYPE_DD=2 ORDER BY DTT.DOC_GROUP_TYPE_DD ASC, DTT.DOC_TYPE_DD ASC"
        Set ActiveRecordset = DatabaseMethods.SQLQueryDatabaseRecordset(SQLQueryCode)
    
    
        DatabaseMethods.SQLCloseDatabaseConnection
        
        With MMCARMS.ValidateDocFrame.ValidateDocBorderFrame.TypeDropDownBoxDoc
            'Add item to state dropdown
            .AddItem "Select A Document Type"
        
            'Load the State into the dropdown lists as items
            While Not ActiveRecordset.EOF
                .AddItem ActiveRecordset.Fields("DOC_TYPE_DESCRIPTION").value
                ActiveRecordset.MoveNext
            Wend
    
    
            .ListIndex = 0
        End With
        
    End Sub
    
    
    
    
    'This for bringing up the add new policy subroutine
    Sub NewCommentBoxPolicy(PolicyGrouping As Integer)
    
    
        'Clear All variables
        MMCARMS.CommentTextBox_POL.Text = ""
        MMCARMS.CommentText_POL.Caption = "Please use the textbox below to add your comment for Policy Item " & PolicyGrouping & "."
        ActivePolicyGrouping = PolicyGrouping
    
    
        With MMCARMS.MMCIDMainBlurrImage
            .Width = MMCARMS.Width
            .Height = MMCARMS.Height
            .Top = 0
            .Left = 0
            .Visible = True
            .ZOrder (0)
        End With
        
        With MMCARMS.Comment_POLFrame
            .Height = 336
            .Width = 468
            .Left = MMCARMS.MMCIDMainBlurrImage.Left + (0.5 * MMCARMS.MMCIDMainBlurrImage.Width) - (0.5 * .Width)
            .Top = MMCARMS.MMCIDMainBlurrImage.Top + (0.5 * MMCARMS.MMCIDMainBlurrImage.Height) - (0.5 * .Height)
            .Visible = True
            .ZOrder (0)
        End With
       
    End Sub
    
    
    Sub UpdatedResolved(PolicyGrouping As Integer)
    
    
        DatabaseMethods.SQLOpenDatabaseConnection DatabaseDirectory, 0
        SQLQueryCode = "INSERT INTO POLICY_GROUP_RESOLUTION(MMCID,WHO_RESOLVED, WHEN_RESOLVED, POLICY_GROUPING,RESOLVED) " & _
                       "VALUES(" & ActiveMMCID & "," & UserNumber & ",FORMAT(#" & Now() & "#,'MM/DD/YYYY HH:mm:ss')," & PolicyGrouping & ", TRUE)"
        Call DatabaseMethods.SQLWriteDatabase(SQLQueryCode)
        DatabaseMethods.SQLCloseDatabaseConnection
    
    
        MMCARMS.FillPolTab_MRP
    End Sub
    
    
    Public Function SortDictionaryByValue(dict As Object _
                        , Optional sortorder As XlSortOrder = xlAscending) As Object
        
        On Error GoTo eh
        
        Dim arrayList As Object
        Set arrayList = CreateObject("System.Collections.ArrayList")
        
        Dim dictTemp As Object
        Set dictTemp = CreateObject("Scripting.Dictionary")
       
        ' Put values in ArrayList and sort
        ' Store values in tempDict with their keys as a collection
        Dim key As Variant, value As Variant, coll As Collection
        For Each key In dict
        
            value = dict(key)
            
            ' if the value doesn't exist in dict then add
            If dictTemp.Exists(value) = False Then
                ' create collection to hold keys
                ' - needed for duplicate values
                Set coll = New Collection
                dictTemp.Add value, coll
                
                ' Add the value
                arrayList.Add value
                
            End If
            
            ' Add the current key to the collection
            dictTemp(value).Add key
        
        Next key
        
        ' Sort the value
        arrayList.Sort
        
        ' Reverse if descending
        If sortorder = xlDescending Then
            arrayList.Reverse
        End If
        
        dict.RemoveAll
        
        ' Read through the ArrayList and add the values and corresponding
        ' keys from the dictTemp
        Dim item As Variant
        For Each value In arrayList
            Set coll = dictTemp(value)
            For Each item In coll
                dict.Add item, value
            Next item
        Next value
        
        Set arrayList = Nothing
        
        ' Return the new dictionary
        Set SortDictionaryByValue = dict
            
    Done:
        Exit Function
    eh:
        If Err.Number = 450 Then
            Err.Raise vbObjectError + 100, "SortDictionaryByValue" _
                    , "Cannot sort the dictionary if the value is an object"
        End If
    End Function
    
    
    Public Function SortDictionaryByKey(dict As Object _
                      , Optional sortorder As XlSortOrder = xlAscending) As Object
        
        Dim arrList As Object
        Set arrList = CreateObject("System.Collections.ArrayList")
        
        ' Put keys in an ArrayList
        Dim key As Variant, coll As New Collection
        For Each key In dict
            arrList.Add key
        Next key
        
        ' Sort the keys
        arrList.Sort
        
        ' For descending order, reverse
        If sortorder = xlDescending Then
            arrList.Reverse
        End If
        
        ' Create new dictionary
        Dim dictNew As Object
        Set dictNew = CreateObject("Scripting.Dictionary")
        
        ' Read through the sorted keys and add to new dictionary
        For Each key In arrList
            dictNew.Add key, dict(key)
        Next key
        
        ' Clean up
        Set arrList = Nothing
        Set dict = Nothing
        
        ' Return the new dictionary
        Set SortDictionaryByKey = dictNew
            
    End Function
    Code:
    'Monitor width and height constants
    Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal index As Long) As Long
    Public Const SM_CXSCREEN = 0
    Public Const SM_CYSCREEN = 1

  8. #8
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    So i got the error again and still points straight to the workbook_open even with it set to break for class modules. If I delete everything in thisworkbook_open and hit run inside it I still get the file not found error but it doesnt highlight workbook_open just triggers that message box. This is so confusing!!
    Last edited by bradyboyy88; May 21st, 2018 at 03:35 PM.

  9. #9
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    31,598
    Post Thanks / Like
    Mentioned
    14 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Weird excel error

    That's a pretty large amount of code for one module. Try splitting it up over a few modules.

  10. #10
    Board Regular
    Join Date
    Feb 2015
    Posts
    410
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Weird excel error

    The one module (Userform Module) with the applications code has atleast 30x that lol. 7200 lines of code to be exact.
    Last edited by bradyboyy88; May 21st, 2018 at 03:48 PM.

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

DMCA.com