1

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!

Improve this question

2 Answers 2

Reset to default
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

Improve this answer
Sign up to request clarification or add additional context in comments.

3 Comments

Will give that a try thanks :) Although would need to set most of those values to on protect to FALSE heh.
Well after some testing that seemed to help a bit by modifying the loop to this: For Each ws in ActiveWorkbook.Worksheets, so not sure if it didnt like looping on a variable or got confused. I also added your suggestion of checking whether the sheet was protected with If ws.ProtectContents = True and added some debugging to let me know when it is successful. It still seems hit and miss however as will sometimes still crash out with the same error during the loop and will always do so when I try modifying each sheet in the loop with e.g. ws.Range("C12").Value = "?" causes Excel to crash.
Sorry to hear man, should ws.Range("C12").Value = "?" not be ws.Range("C12").Value = ""?"", to change the wildcard to a character?
1

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.

Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.