Excel VBA - Automation Error during loop - vba

Question

Hello there fellow StackOverflow users,
So my issue is with a workbook that heavily uses VBA to automate and calculate several functions. However the one in particular is a function I wrote that updates the code and named ranges of the workbook when the master copy is updated, which is done simply by a version number in a cell check.
Function updateCheck(cVer As Double) As Double
Dim currWB As Workbook, isWB As Workbook, iSht As Worksheet, ver As Range, wbName As String, path As String
Dim isCode As CodeModule, wbCode As CodeModule, wbMod As CodeModule, isMod As CodeModule, isNames As New Collection, isVal As New Collection
Dim tmp As Name, nm As Name, ws As Worksheet, tn As Range, verNum As Double, nStr As String, raf As Boolean, tStr As String
path = "Q:\JWILDE\": wbName = "testsheet.xlsm"
Set currWB = ThisWorkbook
With currWB
.Activate
Set wbCode = .VBProject.VBComponents("ThisWorkbook").CodeModule
Set iSht = .Sheets(1)
End With
If Dir(path & wbName) <> "" And Not currWB.path & "\" Like path Then
Set isWB = Workbooks.Open(path & wbName, ReadOnly:=True)
isWB.Activate
verNum = isWB.Names("VerNum").RefersToRange
Else
updateCheck = cVer
Exit Function
End If
If cVer < verNum Then
Debug.Print "...update required, current version: " & verNum
With isWB
With .VBProject
Set isMod = .VBComponents("ISCode").CodeModule
Set isCode = .VBComponents("ThisWorkbook").CodeModule
End With
'--- COMPILES LIST OF NAMES FROM STANDARD SHEET ---
For Each nm In .Names
nVal = "=SHT!"
key = getNRVal(nm.Name, 3)
nStr = getNRVal(nm.RefersToLocal, 3)
Debug.Print "Sheet set to: " & getNRVal(nm.Name, 1)
.Sheets(getNRVal(nm.Name, 1)).Unprotect Password:="jwedit"
Set tn = .Sheets(getNRVal(nm.Name, 1)).Range(nStr) 'Untested...
On Error Resume Next
tStr = isNames(key)
If tStr <> "" Then
tStr = ""
Else
If nm.Parent.Name = .Name Then
Set tn = .Sheets(1).Range(nStr)
nVal = "=WB!"
isVal.Add tn, key
Debug.Print "isVal > " & isVal(key).Name
End If
isNames.Add key & nVal & nStr, key
Debug.Print "...added: " & isNames.Item(key)
End If
Next nm
End With
If isCode.CountOfLines > 0 And isMod.CountOfLines > 0 Then
With currWB.VBProject
Set wbCode = .VBComponents("ISCode").CodeModule
wbCode.DeleteLines 1, wbCode.CountOfLines
wbCode.AddFromString isMod.Lines(1, isMod.CountOfLines)
Set wbCode = .VBComponents("ThisWorkBook").CodeModule
wbCode.DeleteLines 1, wbCode.CountOfLines
wbCode.AddFromString isCode.Lines(1, isCode.CountOfLines)
updateCheck = verNum
End With
Else
Debug.Print "Error. Unable to get updated code."
updateCheck = cVer
End If
isWB.Close SaveChanges:=False
currWB.Activate
On Error Resume Next
Dim wbStr As String: wbStr = isWB.Name
If wbStr <> "" Then
Debug.Print "WARNING: " & wbStr & " is still open!"
Else: Debug.Print "Successfully closed isWB."
End If
'--- CHECKS THROUGH EACH SHEET FROM CURRENT WB ---
For Each ws In currWB.Worksheets
ws.Unprotect Password:="jwedit"
'--- CHECK TO REMOVE INVALID OR INCORRECT NAMES ---
For Each nm In ws.Names
raf = False
key = getNRVal(nm.Name, 3) '--> SHEET!NAME > NAME
nStr = getNRVal(nm.RefersTo, 3) '---> SHEET!REF > REF
tStr = isNames(key) 'Could change this to: getNRVal(isNames(key),3) to return just REF or nothing.
Debug.Print "...[" & key & "]..."
If tStr <> "" Then 'MATCH FOUND...
Set tn = ws.Range(getNRVal(tStr, 3)) 'Should be the CORRECT RefTo from isNames.
'--- NAME ON WRONG SHEET ---
If ws.Index > 1 And getNRVal(tStr, 2) Like "WB" Then
Debug.Print " > REMOVE: [" & key & "] does not belong on " & ws.Name
nm.Delete
'--- NAME CORRECT BUT REFTO ISNT ---
ElseIf Not nStr Like getNRVal(tStr, 3) Then
Debug.Print " > INCORRECT: REF (" & nStr & ") of [" & key & "] should be (" & tn.Address & ")."
nm.RefersTo = tn
End If
tStr = ""
Else '--- NO MATCH FOUND / INVALID NAME ---
Debug.Print " > REMOVE: [" & key & "] is invalid."
raf = True
End If
If raf = True Then
Set tn = ws.Range(nStr)
tn.ClearContents
nm.Delete
End If
Next nm
'--- CHECKING FOR NAMES TO ADD ---
For n = 1 To isNames.Count
raf = False
key = getNRVal(isNames(n), 1) '--> NAME
nStr = getNRVal(isNames(n), 3) '--> REF
nVal = getNRVal(isNames(n), 2) '--> SHT/WB
Debug.Print "Looking for [" & key & "] on " & ws.Name
If ws.Index = 1 And nVal Like "WB" Then
tStr = currWB.Names(key, RefersTo:=nStr)
If tStr <> "" Then
tStr = ""
Else: raf = True
End If
ElseIf ws.Index > 1 And nVal Like "SHT" Then
tStr = ws.Names(key, RefersTo:=nStr)
If tStr <> "" Then
tStr = ""
Else: raf = True
End If
End If
If raf = True Then
Set tn = ws.Range(nStr)
ws.Names.Add key, tn
tStr = isVal(key).Name
If tStr <> "" Then
ws.Names.Add key, tn
tn.Value = isVal(key).Value
End If
Debug.Print " > ADDED: [" & ws.Names(key).Name & "] with REF [" & ws.Names(key).RefersToLocal & "] on " & ws.Name
End If
Next n
ws.Protect Password:="jwedit", UserInterfaceOnly:=True, AllowFormattingCells:=False
Next ws
Debug.Print " --- DONE CHECKING NAMES --- "
iSht.Activate
updateCheck = verNum
isWB.Close SaveChanges:=False
Else
Debug.Print "No update needed."
updateCheck = verNum
End If
End Function
Did my best to make it all readable, and sorry if its a bit messy. I think I have narrowed down the problem to do with protecting/unprotecting the sheets within the For Each ws in currWB.Worksheets loop as when even when I comment out the other loops for adding/removing names it still causes an Automation Error and then Excel crashes. I should also mention that every sheet only has a select cells that are editable/unprotected to try and avoid unwanted editing and format changing, which is why I need to unprotect before adding/removing names or changing cell values it seems.
Any help on this would be appreciated, or even comments if you feel I could do this any better.
Thank you!

Answer 1

I remember having this error and it was to do with how I was protecting the sheet for a finish I used -
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = True Then
ws.Unprotect "password"
End If
Next ws
and this
For Each ws In ActiveWorkbook.Worksheets
ws.Protect "password", DrawingObjects:=True, Contents:=True, _
AllowSorting:=True, AllowFiltering:=True
Next ws
to protect

Answer 2

OK - I think...problem solved or found or both. Although the answer above did help thank you.
Seems the problem was down to possibly having code in the worksheet_activate and worksheet_change function, which may well have caused some continuous loop when iterating through the sheets. This was resolved simply by using Application.EnableEvents = False before the Function above is called as I don't intend any other functions/subs to be run when looping through sheets like this.