dgardineer
New Member
- Joined
- Oct 31, 2012
- Messages
- 13
I'm using Excel 2016 and windows 10. Has anyone run into this issue before or have any ideas on what to try to resolve? I have an Excel Application which is very slow in 2016 and 365. My workbook is designed to build a scenario by copying template sheets (In the workbook) and then allowing the user to input data onto those copied sheets. The application keeps track of those copied sheets and input data and does a summation. The slowness is partly because the "Template" sheets contain a lot of formatting and some Active-X controls. This is slowing the application down. So I decided to extract the template sheets out to there own workbook and then have the main workbook open and copy templates from these newly created template files. The copy works fine but since the "Template" sheet contains links I had to write code to update them so to not create links to the "Template" workbook. The code to update data validation links works fine. The code to update in cell dropdowns also works fine. The issue I'm having is updating the listfillrange in the Active-X controls that are coped with the template sheet. My code works fine and the listfillrange is updated and working correctly. The problem comes when I close the workbook. Once it's saved and closed, I try to re-open it and I get "We found a problem with some content in < my workbook > Do you want us to try to recover as much as we can?". This happens every time and no matter how I re-code the routine it still happens. I run the following code to fix the links after the copy statement and a doevents.
Public Sub Fix_SheetLinks(xOldName As String, xNewName As String, xTemplateName As String)
On Error Resume Next
Dim wsAdded As Worksheet
Dim sLinkReplace As String
Dim sValidation As String
Dim icnt As Integer
Dim iHowMany As Integer
Dim sRange(50) As String
Dim sFormula(50) As String
Dim OLE_Object As OLEObject
Dim sLink As String
Dim iLoc As Integer
' Newly copied sheet from Template file
Set wsAdded = ThisWorkbook.Sheets(xNewName)
' link to be removed
sLinkReplace = ThisWorkbook.Path & "\[" & xTemplateName & "]"
wsAdded.Activate
' Update cells with links
wsAdded.Cells.Replace What:=sLinkReplace, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Do Data Validation and olecontrols
Select Case xOldName
Case "Cond1"
iHowMany = 2
sRange(0) = "I13:K13"
sRange(1) = "C14:F14"
sFormula(0) = "=Lookup!$BI$3:$BI$117"
sFormula(1) = "=Lookup!$BC$2:$BC$11"
DoEvents
' update listfillrange of 19 active-x controls
icnt = 1
Do Until icnt > 19
'This is what is causing the error. If I remove this there is no error (But maintains a link to template file). Include it and it causes the problem
wsAdded.OLEObjects("cbxCountry" & icnt).ListFillRange = "=Lookup!M3:M250"
icnt = icnt + 1
Loop
Case "Cond2"
' more code
End Select
icnt = 0
Do Until icnt > iHowMany - 1
With wsAdded.Range(sRange(icnt)).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=sFormula(icnt)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
icnt = icnt + 1
Loop
Set wsAdded = Nothing
ThisWorkbook.Save
End Sub
Is this because the Active-X controls have not been fully copied from the template file? I thought that Doevents was supposed to delay the execution until the sheet is fully copied. If it is then how can there be corruption by just updating the listfillrange. Any insight into what might be happening would be greatly appreciated. Just a note. Yes I repaired my Office Installation. No change.
Public Sub Fix_SheetLinks(xOldName As String, xNewName As String, xTemplateName As String)
On Error Resume Next
Dim wsAdded As Worksheet
Dim sLinkReplace As String
Dim sValidation As String
Dim icnt As Integer
Dim iHowMany As Integer
Dim sRange(50) As String
Dim sFormula(50) As String
Dim OLE_Object As OLEObject
Dim sLink As String
Dim iLoc As Integer
' Newly copied sheet from Template file
Set wsAdded = ThisWorkbook.Sheets(xNewName)
' link to be removed
sLinkReplace = ThisWorkbook.Path & "\[" & xTemplateName & "]"
wsAdded.Activate
' Update cells with links
wsAdded.Cells.Replace What:=sLinkReplace, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Do Data Validation and olecontrols
Select Case xOldName
Case "Cond1"
iHowMany = 2
sRange(0) = "I13:K13"
sRange(1) = "C14:F14"
sFormula(0) = "=Lookup!$BI$3:$BI$117"
sFormula(1) = "=Lookup!$BC$2:$BC$11"
DoEvents
' update listfillrange of 19 active-x controls
icnt = 1
Do Until icnt > 19
'This is what is causing the error. If I remove this there is no error (But maintains a link to template file). Include it and it causes the problem
wsAdded.OLEObjects("cbxCountry" & icnt).ListFillRange = "=Lookup!M3:M250"
icnt = icnt + 1
Loop
Case "Cond2"
' more code
End Select
icnt = 0
Do Until icnt > iHowMany - 1
With wsAdded.Range(sRange(icnt)).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=sFormula(icnt)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
icnt = icnt + 1
Loop
Set wsAdded = Nothing
ThisWorkbook.Save
End Sub
Is this because the Active-X controls have not been fully copied from the template file? I thought that Doevents was supposed to delay the execution until the sheet is fully copied. If it is then how can there be corruption by just updating the listfillrange. Any insight into what might be happening would be greatly appreciated. Just a note. Yes I repaired my Office Installation. No change.