Newer excel crashes often and sometimes wipes my comboboxes

[brusk]

Myself and other coworkers have been having this weird problem the past month or so. Opening a workbook will crash excel and it will ask if you want to run in safe mode on the next opening of that workbook. Occasionally it will crash and without even saving the next time the workbook is open it will corrupt the 4 comboboxes I have on different sheets. They will still display but will not work and running a compile it will complain that object doesn't exist. I've reinstalled O365 today and that did not help. I actually corrupted my workbook 8 times today just added 5 lines of code to fix a few minor issues that were found. This is a workbook that's been updated and been added to with no issues for the last 10 years. Why does Microsoft insist on making my job more difficult than it needs to be.

 

[Akuini]

Are you talking about activex combobox?
How do you load the comboboxes list? using .Listfillrange or .List method?
Using .Listfillrange could sometimes crash Excel.

 

[brusk]

Are you talking about activex combobox?
How do you load the comboboxes list? using .Listfillrange or .List method?
Using .Listfillrange could sometimes crash Excel.

Actually the four I have are on sheets that are VeryHidden until they are needed depending on which product I'm configuring. The code on these sheets do an .additem to populate the combobox and only on Worksheet_Activate. So I'm really confused on why just opening the workbook its crashing.

 

[Akuini]

Not sure why that happened, but the ActiveX control (on the sheet) is known to be unpredictably unstable.
If you want, you could upload a sample workbook (without sensitive data) to a file-sharing site like Dropbox.com or Google Drive, and then share the link here. Also, ensure that the link is accessible to anyone.

 

[brusk]

I may have to recreate this entire workbook as it's just doing too many unpredictable things. I ran a repair on it and didn't notice anything that was noticeably stripped so I thought that might be good enough. After using it for several hours it suddenly became unusable. Out of know where it didn't know how to filter/unfilter tables or be able to add a record to the table. I had several versions saved over a few hours of adding data to it and the older versions will work but after some time they also start experience even different failure points.

Unfortunately since this excel template has so much proprietary information I can't publicly post it, if recreating it doesn't fix the issues I'll post it on a dropbox and DM you with the link. Also should I be concerned about any of the following areas

1. Customer Ribbon that hides/unhides shortcuts based on products being configured in the workbook, originally added with Custom UI editor and later edited with Office RibbonX Editor
2. 34 VBA Forms, mostly having the controls built out dynamically so less static controls to get corrupt
3. 5 Modules
4. 1 Class module
5. 4 ActiveX controls on the sheets, 1 check box and three drop downs. The drop downs are populated from worksheet activate event
6. 20 Sheets, 2 always very hidden and others depending on products selected. 4 of these have code based off the ActiveX controls

I was thinking this go around to drop the ActiveX drop downs as I have had problems with those in the past where they would become pictures. Is there another best alternative.

 

[Akuini]

..... and DM you with the link.

Actually you can't do that, it against Forum rule no 4 Message Board Rules.
You need to share the link here so that everybody has access to it.

 

[brusk]

well I'll hope it doesn't come down to needing to post it then since that would go against company policy. I could share it will select individuals just can't have the entire thing out on the internet where people can accidentally come across it.

 

[brusk]

After recreating my entire workbook and importing all the VBA section I found a problem. I can't quite understand why that would be causing issues. When it fails excel partially works, I'm able to do some functions like change sheets, right click and get menus but left click does not work on anything and the formula bar never populates when do move around. If the workbook at this point will not save or close and the only option is a task manager end task. Also there is a chance that the unsaved workbook has became corrupt, after failing the workbook dozens of times I had to revert to a back up copy several times as it would crash excel upon opening.

Below are a few code pieces. The first is the code from the form that collects basic data about a product. This form is started from a main form that will pass over the product code. Interestingly this was only failing when product PM was sent. the 2nd is my querytable function that I'm using to query the tables storing all my data. This function was created as a need to replace the ACE/JET OLEDB that I used for almost 10 years with no issues until suddenly I had several coworkers and partners that either had complete failures due to missing .dll's or lack of data return for some reason. The fix was to add the IF statement called out below. i stepped through it during a failure and what I found was the arSystems = QueryTable line did not return any data so the iLoop1 was skipped. I stopped the code immediately after seeing this before the End If for that section and that was enough to cause Excel to fail.

Option Explicit
Dim ctrlCollection As Collection
Private wb As Workbook
Private ld As Worksheet
Private cd As Worksheet
Private sObj As String
Private ctrl As MSForms.Control
Private iProductCnt As Integer
Private sCustomerName As String
Private arAssetID() As String
Private arAlias() As String
Private blInitialized As Boolean
Private iServerCnt As Integer
Private arNetwork As Variant
Private sProduct As String
Private arServerCnt() As Integer
Private arConType As Variant
Private arVersions As Variant
Private blMsg As Boolean
Private blIsRunning As Boolean
Public Property Let Product(Value As String)
    sProduct = Value
End Property
' Using Activate to Initialize the Form to pass Product variable
Private Sub UserForm_Activate()
    If Not blInitialized = True Then
        Call SetVariables
        Call CreateControls
        Call AssignClassControls
        Call ReadData
        blInitialized = True
        Me.mpFeatures.Value = 1
    End If
End Sub
' #Region --Assign Classes--
Private Sub AssignClassControls()
    Dim obj As clsControlEvents
    Set ctrlCollection = New Collection
        For Each ctrl In Me.Controls
            ' Textbox Controls
            If IsLike(ctrl.Name, Array("txt_SystemAlias*", "txt_ServLoc*")) Then
                Set obj = New clsControlEvents
                Set obj.TextboxControl = ctrl
                obj.MinLength = 3
                ctrlCollection.Add obj
            ElseIf ctrl.Name Like "txt_CertExpiration*" Then
                Set obj = New clsControlEvents
                Set obj.TextboxControl = ctrl
                If sProduct Like "Via*" Then obj.MinLength = 7 Else obj.MinLength = 10
                ctrlCollection.Add obj
            ElseIf ctrl.Name Like "txt_AssetID*" Then
                Set obj = New clsControlEvents
                Set obj.TextboxControl = ctrl
                Set obj.Form = Me
                obj.MinLength = 6
                obj.NumberCheck = True
                obj.ZeroPrefixCheck = True
                obj.TriggerObj = Me.trgTB.Name
                obj.TriggerVal = ctrl.Name
                ctrlCollection.Add obj
            ' Checkbox Controls
            ElseIf ctrl.Name Like "chk_SDT*" Then
                Set obj = New clsControlEvents
                Set obj.CheckboxControl = ctrl
                Set obj.Form = Me
                obj.TriggerObj = Me.trgTB.Name
                obj.TriggerVal = ctrl.Name
                ctrlCollection.Add obj
            ' Combobox Controls
            ElseIf ctrl.Name Like "cbo_Version*" Then
                Set obj = New clsControlEvents
                Set obj.ComboboxControl = ctrl
                obj.MinLength = 2
                ctrlCollection.Add obj
            ElseIf IsLike(ctrl.Name, Array("cbo_SystemType*", "cbo_Profile*", "cbo_CertProvider*")) Then
                Set obj = New clsControlEvents
                Set obj.ComboboxControl = ctrl
                Set obj.Form = Me
                obj.MinLength = 1
                ctrlCollection.Add obj
            ElseIf IsLike(ctrl.Name, Array("cbo_ServerCnt*", "cbo_InstallType*", "cbo_Premise*")) Then
                Set obj = New clsControlEvents
                Set obj.ComboboxControl = ctrl
                Set obj.Form = Me
                obj.TriggerObj = Me.trgTB.Name
                obj.TriggerVal = ctrl.Name
                obj.MinLength = 1
                ctrlCollection.Add obj
            ' Button Controls
            ElseIf ctrl.Name Like "btn_*" Then
                Set obj = New clsControlEvents
                Set obj.ButtonControl = ctrl
                Set obj.Form = Me
                obj.TriggerObj = Me.trgTB.Name
                obj.TriggerVal = ctrl.Name
                ctrlCollection.Add obj
            End If
        Next ctrl
    Set obj = Nothing
End Sub
' #Region --Event Changes--
Private Sub trgTB_Change()
    Dim arName As Variant
    Dim arValues As Variant
    Dim iServerCnt As Integer
    Dim sConnection As String
    Dim iSystem As Integer
    Dim blFound As Boolean
    Dim iLoop1 As Integer
    
    If blIsRunning = False Then
        blIsRunning = True
    
        If Me.trgTB.Value Like "txt*AssetID*" Then
            If Len(Me.Controls(Me.trgTB.Value).Value) >= 6 Then
                Call AssetIDCheck(sProduct, Me.Controls(Me.trgTB.Value), Me, Me.trgTB.Value)
            End If
        ElseIf Me.trgTB.Value Like "cbo_ServerCnt*" Then
            If IsNumeric(Me.Controls(Me.trgTB.Value).Tag) Then
                arName = Split(Me.trgTB.Value, "_")
                iSystem = arName(2)
                If sProduct = "ViaWFM" Then
                    If IsNumeric(Me.Controls("cbo_PremServerCnt_" & iSystem).Value) Then
                        iServerCnt = CInt(Me.Controls(Me.trgTB.Value).Value) + CInt(Me.Controls("cbo_PremServerCnt_" & iSystem).Value)
                        If iServerCnt < CInt(Me.Controls(Me.trgTB.Value).Tag) Then
                            frmDelete.Form = Me.Name
                            frmDelete.DeleteOption = "Server_" & sProduct
                            frmDelete.DeleteFeature = arName(1)
                            frmDelete.DeleteCount = Me.Controls(Me.trgTB.Value).Tag - iServerCnt
                            frmDelete.DeleteAssetID = Me.Controls("txt_AssetID_" & arName(UBound(arName))).Value
                            frmDelete.DeleteAlias = Me.Controls("txt_SystemAlias_" & arName(UBound(arName))).Value
                            Unload Me
                            frmDelete.Show
                            Exit Sub
                        End If
                    End If
                Else
                    iServerCnt = CInt(Me.Controls(Me.trgTB.Value).Value)
                    If iServerCnt < CInt(Me.Controls(Me.trgTB.Value).Tag) Then
                        frmDelete.Form = Me.Name
                        frmDelete.DeleteOption = "Server_" & sProduct
                        frmDelete.DeleteFeature = arName(1)
                        frmDelete.DeleteCount = Me.Controls(Me.trgTB.Value).Tag - iServerCnt
                        frmDelete.DeleteAssetID = Me.Controls("txt_AssetID_" & arName(UBound(arName))).Value
                        frmDelete.DeleteAlias = Me.Controls("txt_SystemAlias_" & arName(UBound(arName))).Value
                        Unload Me
                        frmDelete.Show
                        Exit Sub
                    End If
                End If
            End If
        ElseIf Me.trgTB.Value Like "cbo_Premise*" Then
            arName = Split(Me.trgTB.Value, "_")
            Me.Controls("btn_URLs_" & arName(2)).visible = (IsIn(Me.Controls(Me.trgTB.Value).Value, Array("Hosted", "Cloud")))
            If sProduct = "WFM" And Me.Controls("cbo_Premise_" & arName(2)).Value = "Hosted" Then Me.Controls("chk_IS_" & arName(2)).Value = True
        ElseIf Me.trgTB.Value Like "btn_Add*" Then
            arName = Split(Me.trgTB.Value, "_")
            iSystem = arName(2)
            blFound = False
            If Len(Me.Controls("cbo_Systems_" & iSystem).Value) > 0 And (Len(Me.Controls("cbo_ConnectionType_" & iSystem).Value) > 0 Or Not IsIn(sProduct, Array("ViaWFM", "WFM", "AQM"))) Then
                For iLoop1 = 0 To Me.Controls("lst_Connections_" & iSystem).ListCount - 1
                    If Me.Controls("cbo_Systems_" & iSystem).Value = Me.Controls("lst_Connections_" & iSystem).List(iLoop1, 0) Then
                        blFound = True
                    End If
                Next iLoop1
                If blFound = False Then
                    Me.Controls("lst_Connections_" & iSystem).AddItem ("")
                    Me.Controls("lst_Connections_" & iSystem).List(Me.Controls("lst_Connections_" & iSystem).ListCount - 1, 0) = Me.Controls("cbo_Systems_" & iSystem).Value
                    Me.Controls("lst_Connections_" & iSystem).List(Me.Controls("lst_Connections_" & iSystem).ListCount - 1, 1) = Me.Controls("cbo_ConnectionType_" & iSystem).Value
                End If
            End If
        ElseIf Me.trgTB.Value Like "btn_Remove*" Then
            arName = Split(Me.trgTB.Value, "_")
            iSystem = arName(2)
            If Me.Controls("lst_Connections_" & iSystem).ListIndex >= 0 Then
                Me.Controls("lst_Connections_" & iSystem).RemoveItem (Me.Controls("lst_Connections_" & iSystem).ListIndex)
            End If
        ElseIf Me.trgTB.Value Like "chk_SDT*" Then
            arName = Split(Me.trgTB.Value, "_")
            iSystem = arName(2)
            Me.Controls("lbl_CertProvider_" & iSystem).visible = Me.Controls(Me.trgTB.Value).Value
            Me.Controls("cbo_CertProvider_" & iSystem).visible = Me.Controls(Me.trgTB.Value).Value
            Me.Controls("lbl_CertExpiration_" & iSystem).visible = Me.Controls(Me.trgTB.Value).Value
            Me.Controls("txt_CertExpiration_" & iSystem).visible = Me.Controls(Me.trgTB.Value).Value
        ElseIf Me.trgTB.Value Like "btn_URLs*" Then
            frmURLs.Form = Me.Name
            frmURLs.Product = sProduct
            Unload Me
            frmURLs.Show
            Exit Sub
        End If
        Me.trgTB.Tag = ""
        Me.trgTB.Value = ""
        Me.Repaint
        blIsRunning = False
    End If
End Sub
' #Region --Procedures--
Private Sub SetVariables()
    If sProduct = "" Then sProduct = "PM"
    Set wb = ThisWorkbook
    Set cd = wb.Sheets("ConfigurationData")
    Set ld = wb.Sheets("LookupData")
    iProductCnt = cd.Range("cnf" & sProduct & "Cnt").Value
    ReDim arAssetID(1 To iProductCnt)
    ReDim arAlias(1 To iProductCnt)
    ReDim arServerCnt(1 To iProductCnt)
    Dim arSystems As Variant
    Dim iConfiguredCnt As Integer
    Dim arNetwork As Variant
    Dim iLoop1 As Integer
    Dim iLoop2 As Integer
    
    sCustomerName = cd.Range("cnfCustomerName").Value
    Me.Caption = sProduct & " Features"
    arVersions = Split(ld.Range("ld" & sProduct & "Versions").Value, "|")
    arSystems = cd.Range("cnfTableSystems").Value
    arNetwork = cd.Range("cnfTable" & sProduct & "Network").Value
    Select Case sProduct
        Case "ViaWFM"
            iServerCnt = 80
            arConType = Array("Enter Connection Name")
        Case "WFM"
            iServerCnt = 80
            arConType = Array("Enter Connection Name")
        Case "QM"
            iServerCnt = 50
            arConType = Array("CTIPS", "Enhanced CTIPS", "TDM Trunk Tapping", "SIP Trunk Tapping", "Call Logger")
        Case "PM"
            iServerCnt = 50
            arConType = Array("")
        Case "CXP"
            iServerCnt = 50
            arConType = Array("")
         Case "Prophecy"
            iServerCnt = 10
            arConType = Array("")
        Case "IT"
            iServerCnt = 50
            arConType = Array("")
        Case "SA"
            iServerCnt = 50
            arConType = Array("")
    End Select
    For iLoop1 = 1 To iProductCnt
        For iLoop2 = LBound(arSystems) To UBound(arSystems)
            If arSystems(iLoop2, 3) = sProduct And arSystems(iLoop2, 2) = iLoop1 Then
                arAssetID(iLoop1) = arSystems(iLoop2, 1)
                arAlias(iLoop1) = arSystems(iLoop2, 4)
            End If
        Next iLoop2
        For iLoop2 = LBound(arNetwork) To UBound(arNetwork)
            If arNetwork(iLoop2, 1) = arAssetID(iLoop1) Then
                If CInt(arNetwork(iLoop2, 12)) > 0 Then arServerCnt(iLoop1) = arServerCnt(iLoop1) + 1
            End If
        Next iLoop2
    Next iLoop1
End Sub
Private Sub CreateControls()
    Dim iLoop1 As Integer
    Dim arResults() As String
    Dim tblSystems As ListObject
    Dim arSystems As Variant
    Dim tblSystemDetails As ListObject
    Dim arSystemDetails As Variant
    Dim arSearch As Variant
    Dim arTemp As Variant
    
    Set tblSystems = cd.ListObjects("cnfTableSystems")
    Set tblSystemDetails = cd.ListObjects("cnfTableSystemDetails")
    ReDim arResults(-1 To -1)
    If sProduct = "WFM" Then arSearch = Array("UIP", "AIC", "QM", "Via")
    If sProduct = "QM" Then arSearch = Array("UIP", "AIC", "Via")
    If sProduct = "Prophecy" Then arSearch = Array("CXP")
    If sProduct = "CXP" Then arSearch = Array("UIP")
   [B] If IsIn(sProduct, Array("WFM", "QM", "Prophecy", "CXP")) Then '### If this If is what fixes the issue
        arSystems = QueryTable(sTable:="cnfTableSystems", sCol:="Product", sQuery:=arSearch)
        If UBound(arSystems) > 0 Then
            ReDim arResults(1 To 1)
            For iLoop1 = LBound(arSystems) To UBound(arSystems)
                arSystemDetails = QueryTable(sTable:="cnfTableSystemDetails", sCol:="AssetID", sQuery:=arSystems(iLoop1, 1), sCol2:="Field", sQuery2:="Version")
                ReDim Preserve arResults(1 To iLoop1)
                arResults(iLoop1) = arSystems(iLoop1, 3) & "_" & arSystems(iLoop1, 4) & ":" & arSystemDetails(1, 3)
            Next iLoop1
        End If
    End If '###[/B]
    For iLoop1 = 1 To iProductCnt
        With Me.mpFeatures.Pages.Add
            .Name = sProduct & " System " & iLoop1
            .Caption = sProduct & " System " & iLoop1
            .visible = True
        End With
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_Heading_" & iLoop1, 6, 18, 358, 16, sCaption:=cd.Range("cnfCustomerName").Value & " " & Me.mpFeatures.Pages(iLoop1).Caption, sBackColor:=&H8000000F, sForeColor:=&H8000&, iFontSize:=12, iTextAlign:=2)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_SystemAlias_" & iLoop1, 34, 12, 54, 12, , sCaption:="System Alias", sTag:="System Alias", iTextAlign:=3)
        Call NewTextbox(Me.mpFeatures(iLoop1).Add("Forms.Textbox.1"), "txt_SystemAlias_" & iLoop1, 30, 78, 120, 16, sTag:="System Alias", sBackColor:=&HFF&)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_SystemType_" & iLoop1, 56, 12, 54, 12, sCaption:="System Type", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_SystemType_" & iLoop1, 54, 78, 120, 16, sTag:="SystemType", sBackColor:=&HFF&, arList:=Split(ld.Range("ld" & sProduct & "SystemTypes").Value, "|"))
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_InstallType_" & iLoop1, 81, 12, 54, 12, sCaption:="Install Type", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_InstallType_" & iLoop1, 78, 78, 120, 16, sTag:="Install Type", sBackColor:=&HFF&, arList:=Array("New Install", "Upgrade"))
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_AssetID_" & iLoop1, 34, 230, 42, 12, sCaption:="Asset ID", iTextAlign:=3)
        Call NewTextbox(Me.mpFeatures(iLoop1).Add("Forms.Textbox.1"), "txt_AssetID_" & iLoop1, 30, 294, 60, 16, sBackColor:=&HFF&, iMaxLen:=7)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_Profile_" & iLoop1, 56, 230, 42, 12, sCaption:="Profile", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_Profile_" & iLoop1, 54, 294, 60, 16, sTag:="Profile", arList:=Split(ld.Range("ld" & sProduct & "Profiles").Value, "|"), sValue:="Custom", iStyle:=0)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_Version_" & iLoop1, 81, 230, 42, 12, sCaption:="Version", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_Version_" & iLoop1, 78, 294, 60, 16, arList:=arVersions, sValue:=arVersions(UBound(arVersions)))
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_ServLoc_" & iLoop1, 104, 6, 60, 12, sCaption:="Server Location", iTextAlign:=3)
        Call NewTextbox(Me.mpFeatures(iLoop1).Add("Forms.Textbox.1"), "txt_ServLoc_" & iLoop1, 102, 78, 140, 16, sBackColor:=&HFF&, iMaxLen:=30)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_Premise_" & iLoop1, 104, 224, 60, 12, sCaption:="Premise/Hosted", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_Premise_" & iLoop1, 102, 294, 60, 16, arList:=Array("Premise", "Hosted", "Cloud"), sValue:="Premise", iTextAlign:=1)
        If sProduct = "ViaWFM" Then Me.Controls("cbo_Premise_" & iLoop1).Value = "Cloud"
        Call NewButton(Me.mpFeatures(iLoop1).Add("Forms.CommandButton.1"), "btn_URLs_" & iLoop1, 124, 258, 96, 18, sCaption:="URL's", sBackColor:=&H80000005, blVisible:=False)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_ServerCnt_" & iLoop1, 128, 12, 54, 12, sCaption:="Server Cnt", iTextAlign:=3)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_ServerCnt_" & iLoop1, 126, 78, 35, 16, arList:=NumArray(0, iServerCnt), iTextAlign:=1, sTag:=arServerCnt(iLoop1))
        If sProduct = "WFM" Then
            Call NewCheckbox(Me.mpFeatures(iLoop1).Add("Forms.CheckBox.1"), "chk_IS_" & iLoop1, 126, 132, 96, 16, sCaption:="Integrated Security", sValue:=False, blEnabled:=True)
        End If
        If sProduct = "ViaWFM" Then
            Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_PremServerCnt_" & iLoop1, 128, 118, 84, 12, sCaption:="Premise Server Cnt", iTextAlign:=3)
            Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_PremServerCnt_" & iLoop1, 126, 208, 35, 16, arList:=NumArray(0, 10), iTextAlign:=1, sTag:=arServerCnt(iLoop1))
        End If
        Call NewCheckbox(Me.mpFeatures(iLoop1).Add("Forms.CheckBox.1"), "chk_SDT_" & iLoop1, 150, 32, 56, 16, sCaption:="SSL", sValue:=False, blEnabled:=True)
        Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_CertProvider_" & iLoop1, 152, 65, 60, 12, sCaption:="Cert Provider", iTextAlign:=3, blVisible:=False)
        Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_CertProvider_" & iLoop1, 150, 132, 70, 16, arList:=Array("Customer", "3rdParty"), iTextAlign:=1, sBackColor:=&HFF&, blVisible:=False)
        If sProduct = "ViaWFM" Then
            Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_CertExpiration_" & iLoop1, 152, 230, 60, 12, sCaption:="Cert Domain", iTextAlign:=3, blVisible:=False)
            Call NewTextbox(Me.mpFeatures(iLoop1).Add("Forms.Textbox.1"), "txt_CertExpiration_" & iLoop1, 150, 294, 60, 16, sBackColor:=&HFF&, iMaxLen:=10, blVisible:=False)
        Else
            Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_CertExpiration_" & iLoop1, 152, 230, 60, 12, sCaption:="Cert Expiration", iTextAlign:=3, blVisible:=False)
            Call NewTextbox(Me.mpFeatures(iLoop1).Add("Forms.Textbox.1"), "txt_CertExpiration_" & iLoop1, 150, 294, 60, 16, sBackColor:=&HFF&, iMaxLen:=10, blVisible:=False)
        End If
        If sProduct = "PM" Then
            Call NewLabel(Me.mpFeatures(iLoop1).Add("Forms.Label.1"), "lbl_LicenseType_" & iLoop1, 128, 118, 58, 12, sCaption:="License Type", iTextAlign:=3)
            Call NewCombobox(Me.mpFeatures(iLoop1).Add("Forms.Combobox.1"), "cbo_LicenseType_" & iLoop1, 126, 180, 60, 16, arList:=Array("Standard", "Enterprise"), iTextAlign:=1, sValue:="Standard")
        End If
        If IsIn(sProduct, Array("ViaWFM", "WFM", "QM", "Prophecy", "CXP")) Then
            Me.Height = 414
            Me.mpFeatures.Height = 334
            Me.btnSave.Top = Me.Height - 60
            Me.btnCancel.Top = Me.Height - 60
            
            Call NewGroupbox(Me.mpFeatures(iLoop1).Add("Forms.Frame.1"), "gb_Connections_" & iLoop1, 174, 5, 360, 100, sCaption:="Connection Info", blVisible:=True, sBackColor:=&H8000000F)
            Call NewCombobox(Me.Controls("gb_Connections_" & iLoop1).Add("Forms.Combobox.1"), "cbo_Systems_" & iLoop1, 12, 6, 140, 16, arList:=arResults, iTextAlign:=1, iStyle:=0)
            Me.Controls("cbo_Systems_" & iLoop1).AddItem ("Type to Enter Custom")
            Call NewCombobox(Me.Controls("gb_Connections_" & iLoop1).Add("Forms.Combobox.1"), "cbo_ConnectionType_" & iLoop1, 30, 6, 140, 16, arList:=arConType, iTextAlign:=1, blVisible:=IsIn(sProduct, Array("ViaWFM", "WFM", "AQM")))
            If IsIn(sProduct, Array("ViaWFM", "WFM")) Then Me.Controls("cbo_ConnectionType_" & iLoop1).Style = 0
            Call NewButton(Me.Controls("gb_Connections_" & iLoop1).Add("Forms.CommandButton.1"), "btn_Add_" & iLoop1, 56, 14, 42, 24, sCaption:="Add")
            Call NewButton(Me.Controls("gb_Connections_" & iLoop1).Add("Forms.CommandButton.1"), "btn_Remove_" & iLoop1, 56, 84, 42, 24, sCaption:="Remove")
            Call NewListbox(Me.Controls("gb_Connections_" & iLoop1).Add("Forms.ListBox.1"), "lst_Connections_" & iLoop1, 12, 180, 166, 75, iColumnCount:=2, sColumnWidth:="90;60")
            
        End If
    Next iLoop1
End Sub
Private Sub WriteData()
    Dim arName As Variant
    Dim sValue As String
    Dim sAssetID As String
    Dim iLoop1 As Integer
    Dim iLoop2 As Integer
    
    For iLoop1 = 1 To iProductCnt
        If Len(Me.Controls("txt_AssetID_" & iLoop1).Value) >= 6 Then
            ' Delete Existing Entries from Systems Table
            Call DeleteTable("cnfTableSystems", Me.Controls("txt_AssetID_" & iLoop1).Value)
            ' Write Data to Systems Table
            Call TableAddRecord("cnfTableSystems", Array(Me.Controls("txt_AssetID_" & iLoop1).Value, iLoop1, sProduct, Me.Controls("txt_SystemAlias_" & iLoop1).Value, Me.Controls("cbo_Profile_" & iLoop1).Value))
            ' Delete Existing Entries from System Detail Table
            Call DeleteTable("cnfTableSystemDetails", Me.Controls("txt_AssetID_" & iLoop1).Value)
            ' Write Data to System Detail Table
            
            For Each ctrl In Me.Controls
                If (ctrl.Name Like "txt*" Or ctrl.Name Like "cbo*" Or ctrl.Name Like "chk*") And Not IsLike(ctrl.Name, Array("cbo_Profile*", "cbo_ConnectionType*", "cbo_Systems*")) Then
                    arName = Split(ctrl.Name, "_")
                    If ctrl.visible = True And arName(UBound(arName)) = iLoop1 Then
                        Call TableAddRecord("cnfTableSystemDetails", Array(CStr(Me.Controls("txt_AssetID_" & iLoop1).Value), CStr(arName(1)), ctrl.Value))
                    End If
                ElseIf ctrl.Name Like "lst*" & iLoop1 Then
                    For iLoop2 = 0 To Me.Controls(ctrl.Name).ListCount - 1
                        sValue = Me.Controls(ctrl.Name).List(iLoop2, 0) & "|" & Me.Controls(ctrl.Name).List(iLoop2, 1)
                        arName = Split(ctrl.Name, "_")
                        Call TableAddRecord("cnfTableSystemDetails", Array(CStr(Me.Controls("txt_AssetID_" & iLoop1).Value), CStr(arName(1)), sValue))
                    Next iLoop2
                End If
            Next
        End If
    Next iLoop1
    Call ChangeLog(sProduct & " Features Updated", False)
End Sub
Private Sub ReadData()
    Dim arSystems As Variant
    Dim arSystemDetails As Variant
    Dim arName As Variant
    Dim arValue As Variant
    Dim sAssetID As String
    Dim iLoop1 As Integer
    Dim iLoop2 As Integer
    Dim iLoop3 As Integer
    Dim arResults() As String
    
    'On Error Resume Next
    arSystems = cd.Range("cnfTableSystems").Value
    arSystemDetails = cd.Range("cnfTableSystemDetails").Value
    ReDim arResults(-1 To -1)
    For iLoop1 = 1 To iProductCnt
        For iLoop2 = LBound(arSystems) To UBound(arSystems)
            If arSystems(iLoop2, 3) = sProduct And arSystems(iLoop2, 2) = iLoop1 Then
                Me.Controls("txt_AssetID_" & iLoop1).Value = arSystems(iLoop2, 1)
                sAssetID = arSystems(iLoop2, 1)
                If Len(Me.Controls("txt_AssetID_" & iLoop1).Value) >= 6 Then Me.Controls("txt_AssetID_" & iLoop1).Enabled = False
                Me.Controls("txt_SystemAlias_" & iLoop1).Value = arSystems(iLoop2, 4)
                Me.Controls("cbo_Profile_" & iLoop1).Value = arSystems(iLoop2, 5)

                For Each ctrl In Me.Controls
                    If ctrl.Name Like "txt*" & iLoop1 Or ctrl.Name Like "cbo*" & iLoop1 Or ctrl.Name Like "chk*" & iLoop1 Or ctrl.Name Like "lst*" & iLoop1 Then
                        arName = Split(ctrl.Name, "_")
                        For iLoop3 = LBound(arSystemDetails) To UBound(arSystemDetails)
                            If ctrl.Name Like "lst*" Then
                                If arSystemDetails(iLoop3, 1) = arSystems(iLoop2, 1) And arSystemDetails(iLoop3, 2) = arName(1) Then
                                    arValue = Split(arSystemDetails(iLoop3, 3), "|")
                                    Me.Controls(ctrl.Name).AddItem ("")
                                    Me.Controls(ctrl.Name).List(Me.Controls(ctrl.Name).ListCount - 1, 0) = arValue(0)
                                    Me.Controls(ctrl.Name).List(Me.Controls(ctrl.Name).ListCount - 1, 1) = arValue(1)
                                End If
                            Else
                                If arSystemDetails(iLoop3, 1) = arSystems(iLoop2, 1) And arSystemDetails(iLoop3, 2) = arName(1) Then
                                    ctrl.Value = arSystemDetails(iLoop3, 3)
                                End If
                            End If
                        Next iLoop3
                    End If
                Next
            End If
        Next iLoop2
    Next iLoop1
End Sub
Private Sub DataCheck()
    Dim sMsg As String
    Dim iLoop1 As Integer
    sMsg = "The following items are incomplete! " & vbCrLf
    For iLoop1 = 1 To iProductCnt
        If Len(Me.Controls("txt_SystemAlias_" & iLoop1).Value) < 3 Then sMsg = sMsg & Me.Controls("txt_SystemAlias_" & iLoop1).Tag & vbCrLf
        If Len(Me.Controls("cbo_SystemType_" & iLoop1).Value) < 1 Then sMsg = sMsg & Me.Controls("cbo_SystemType_" & iLoop1).Tag & vbCrLf
        If Len(Me.Controls("cbo_InstallType_" & iLoop1).Value) < 1 Then sMsg = sMsg & Me.Controls("cbo_InstallType_" & iLoop1).Tag & vbCrLf
        If Len(Me.Controls("txt_AssetID_" & iLoop1).Value) < 6 Then sMsg = sMsg & Me.Controls("txt_AssetID_" & iLoop1).Tag & vbCrLf
    Next iLoop1
    If Len(sMsg) > 38 Then
        sMsg = sMsg & vbCrLf & "Please correct these and try again."
        MsgBox (sMsg)
        blMsg = True
    Else
        blMsg = False
    End If
End Sub
' #Region --Buttons--
Private Sub btnCancel_Click()
    Unload Me
    frmConfigurationMenu.Show
End Sub
Private Sub btnSave_Click()
    Call DataCheck
    If blMsg = False Then
        Call WriteData
        Unload Me
        frmConfigurationMenu.Show
    End If
End Sub

Public Function QueryTable(sTable As String, sCol As String, sQuery As Variant, Optional sCol2 As String, Optional sQuery2 As Variant, Optional sCol3 As String, Optional sQuery3 As Variant, Optional sSortCol As String, Optional blDesc As Boolean, Optional arFields As Variant) As Variant
    Dim tbl As ListObject
    Dim iCol As Integer
    Dim iCol2 As Integer
    Dim iCol3 As Integer
    Dim iCnt As Integer
    Dim iSortCol As Integer
    Dim arResults As Variant
    Dim arReturn() As String
    Dim iLoop1 As Integer
    Dim iLoop2 As Integer
    
    Set tbl = GetTable(sTable)
    
    Call WriteLogFile("QueryTable: Table " & tbl.Name & " sCol = " & sCol, True)
    On Error GoTo ERROR:
    
    iCol = CInt(Application.Match(sCol, tbl.HeaderRowRange, 0))
    If sCol2 <> "" Then iCol2 = CInt(Application.Match(sCol2, tbl.HeaderRowRange, 0))
    If sCol3 <> "" Then iCol3 = CInt(Application.Match(sCol3, tbl.HeaderRowRange, 0))
    tbl.AutoFilter.ShowAllData
    tbl.Range.AutoFilter Field:=iCol, Criteria1:=sQuery, Operator:=xlFilterValues
    If sCol2 <> "" Then tbl.Range.AutoFilter Field:=iCol2, Criteria1:=sQuery2, Operator:=xlFilterValues
    If sCol3 <> "" Then tbl.Range.AutoFilter Field:=iCol3, Criteria1:=sQuery3, Operator:=xlFilterValues
    If sSortCol <> "" Then
        Dim rngSort As Range
        Dim tmp As String
        tmp = sTable & "[" & sSortCol & "]"
        Set rngSort = Range(sTable & "[" & sSortCol & "]")
        With tbl.Sort
        .SortFields.Clear
        If blDesc Then
            .SortFields.Add Key:=Range(sTable & "[" & sSortCol & "]"), SortOn:=xlSortOnValues, Order:=xlDescending
        Else
            .SortFields.Add Key:=Range(sTable & "[" & sSortCol & "]"), SortOn:=xlSortOnValues, Order:=xlAscending
        End If
        .Header = xlYes
        .Apply
        End With
    End If
    
    'Find number of rows to set the dimensions of the array
    For iLoop1 = 1 To tbl.DataBodyRange.Rows.Count
        If Not tbl.DataBodyRange.Rows(iLoop1).Hidden Then
            iCnt = iCnt + 1
        End If
    Next iLoop1
    
    ReDim arResults(1 To iCnt, 1 To tbl.DataBodyRange.Columns.Count)
    iCnt = 0
    For iLoop1 = 1 To tbl.DataBodyRange.Rows.Count
        If Not tbl.DataBodyRange.Rows(iLoop1).Hidden Then
            iCnt = iCnt + 1
            For iLoop2 = 1 To tbl.DataBodyRange.Columns.Count
                arResults(iCnt, iLoop2) = tbl.DataBodyRange.Cells(iLoop1, iLoop2).Value
            Next iLoop2
        End If
    Next iLoop1
    
    tbl.AutoFilter.ShowAllData
    tbl.Sort.SortFields.Clear
    QueryTable = arResults

    If IsArray(arFields) Then
        ReDim arReturn(LBound(arResults) To UBound(arResults), LBound(arFields) To UBound(arFields))
        For iLoop1 = LBound(arResults) To UBound(arResults)
            For iLoop2 = LBound(arFields) To UBound(arFields)
                iCol = CInt(Application.Match(arFields(iLoop2), tbl.HeaderRowRange, 0))
                arReturn(iLoop1, iLoop2) = arResults(iLoop1, iCol)
            Next iLoop2
        Next iLoop1
        QueryTable = arReturn
    End If

Exit Function
ERROR:
    tbl.AutoFilter.ShowAllData
    tbl.Sort.SortFields.Clear
    QueryTable = Array("")
    Call WriteLogFile("QueryTable: Table " & tbl.Name & " sCol = " & sCol & "Failed to lookup", True)
End Function

 

[brusk]

It looks like I have found an answer, it's all Microsoft's fault, somehow. It looks like there was a registry setting I had to update. Event viewer showed I was getting errors on the crash for the VBE7.DLL. The link below shows the problem and the fix that so far has fixed my issues.

Excel crashes in VBE7.DLL running or enabling macro

 

[Akuini]

I'm glad you found a solution, and thank you for sharing.