Weird VBA Bug - Workbook.Open & For/Next Loop

[JTannas]

Today, I ran into the weirdest bug I have ever seen in VBA, and I thought you all might find it interesting.
I'll post the workbook on Monday, but here's what I can tell you for now.

The code goes something like this:

Sub Example()

dim arrNames() as variant
dim intLoop as integer
dim intSize as integer: intSize = 0

Set MyWB = Workbook.Open([I].[/I]..)

For intLoop = 1 to MyWB.names.count
       redim.preserve arrNames(intSize)
       arrNames(intSize) = MyWB.Name(intLoop).NameLocal
       intSize = intSize + 1
Next

[I]do stuff with names array[/I]
End Sub

Here's where things get funky: In debug mode, stepping through, everything works fine. In run-time mode, the array comes out... Empty

Things I figured out:
1) Using debug.print MyWB.Names(1).NameLocal right after the Workbook.Open outputs the correct value, so the workbook seems to be opening fine.
2) After the loop runs (in run-time mode), the value of intLoop is zero, indicating that the loop doesn't run at all.
3) Adding Application.Wait(Now()+TimeValue("00:00:01")) before the loop causes it to work correctly. I have no idea why this works.

Essentially, the loop doesn't trigger if there isn't a delay beforehand, and I have no clue why.

 

[Damon Ostrander]

Hi JTannas,

Just a guess, but I suspect MyWB.names.count is evaluating to zero as the loop termination value because it is not waiting until the workbook opens to evaluate it. I suggest you try putting a Debug.Print MyWB.names.count right before the loop. This will print out the value in the Immediate window. It may even solve the problem as it might force MyWB.names.count evaluation to wait for the workbook to open. Another possibility is to assign the loop termination value to a variable, as this might force a wait also. For example:

Sub Example()

dim arrNames() as variant
dim intLoop as integer
dim nCount  As Integer
dim intSize as integer: intSize = 0

Set MyWB = Workbook.Open(...)

nCount = MyWB.names.count

For intLoop = 1 to nCount
       redim.preserve arrNames(intSize)
       arrNames(intSize) = MyWB.Name(intLoop).NameLocal
       intSize = intSize + 1
Next

do stuff with names array
End Sub

Please let me know if any success with this.

Damon

 

[JTannas]

Hi JTannas,

Just a guess, but I suspect MyWB.names.count is evaluating to zero as the loop termination value because it is not waiting until the workbook opens to evaluate it. I suggest you try putting a Debug.Print MyWB.names.count right before the loop. This will print out the value in the Immediate window. It may even solve the problem as it might force MyWB.names.count evaluation to wait for the workbook to open. Another possibility is to assign the loop termination value to a variable, as this might force a wait also. For example:

Please let me know if any success with this.

Damon

Thank you Damon. Either fortunately or unfortunately, I am unable to replicate the bug this morning, even after rolling back the fix I put in place. At this point, I'm ready to blame the whole thing on witchcraft.

If you're still interested though, the complete code is below. It still needs some cleaning up and error handling, but the core of it is complete.

Option Explicit

Sub GrabNamedRanges()
' Purpose: Retrieves all the names ranges from a specified set of workbooks

' Grab the Files
'----------------------------------------------------------------------

Dim xlFilePicker As FileDialog
Set xlFilePicker = Application.FileDialog(msoFileDialogFilePicker)

With xlFilePicker
    .AllowMultiSelect = True
    .Title = "Please select an Excel Workbook"
    .ButtonName = "Grab Named Ranges"
    .Filters.Add "Excel Files", "*.xls?"
    .FilterIndex = 2
    If .Show <> -1 Then Exit Sub
End With

' Create the names storage array
'----------------------------------------------------------------------
Dim arrNames() As Variant
Dim intSize As Integer: intSize = 0
ReDim Preserve arrNames(4, intSize)
arrNames(0, intSize) = "Range Name"
arrNames(1, intSize) = "Range Value"
arrNames(2, intSize) = "Range Comment"
arrNames(3, intSize) = "Refers To"
arrNames(4, intSize) = "Source Workbook"

'----------------------------------------------------------------------
' One at a time, open each workbook to grab data from
' Then grab each name and store it in an array
' Close the workbook down, then move on to the next one
'----------------------------------------------------------------------
Dim i As Integer: i = 1
Dim varPickedFile As Variant
Dim xlWorkbook As Workbook
Application.ScreenUpdating = False
Application.EnableEvents = False

For Each varPickedFile In xlFilePicker.SelectedItems
    
    Set xlWorkbook = Workbooks.Open(varPickedFile, False, True)
    With xlWorkbook
    
        'Delay while the workbook opens fully
        Do
            Application.Wait (Now() + TimeValue("00:00:01"))
        Loop While Application.CalculationState <> xlDone
      
        If .Names.Count = 0 Then GoTo nextwb
        
        For i = 1 To .Names.Count
            If .Names(i).Visible = True Then
            
                intSize = intSize + 1
                ReDim Preserve arrNames(4, intSize)
                arrNames(0, intSize) = .Names(i).Name
                
                If IsArray(Evaluate(.Names(i).Value)) Then
                    arrNames(1, intSize) = "Multicell"
                Else
                    arrNames(1, intSize) = Evaluate(.Names(i).Value)
                End If
                
                arrNames(2, intSize) = .Names(i).Comment
                arrNames(3, intSize) = "'" & .Names(i).RefersTo
                arrNames(4, intSize) = "'" & .FullName
            End If
        Next i
nextwb:
        .Close SaveChanges:=False
    End With
Next
Set xlWorkbook = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True

' Choose a spreadsheet to dump into
'----------------------------------------------------------------------
Dim varWorksheet
Dim wksOutput As Worksheet
Dim strName As String

With ThisWorkbook
rename:
    strName = Application.InputBox("Please name the output worksheet", "Input", "Retrieved Names", Type:=2)
    If strName = "False" Then Exit Sub
    
    ' If the output spreadsheet already exists, set it to it
    For Each varWorksheet In .Worksheets
        If varWorksheet.Name = strName Then Set wksOutput = .Sheets(strName)
    Next
    
    ' If it doesn't exist, make it
    If wksOutput Is Nothing Then
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = strName
        Set wksOutput = .Sheets(strName)
    Else 'If it does exist, double check before proceeding
        Select Case MsgBox("Overwrite the previous " & strName & " spreadsheet?", vbYesNoCancel)
            Case vbYes
                Set wksOutput = .Sheets(strName)
            Case vbNo
                GoTo rename
            Case vbCancel
                Exit Sub
            Case Else
                Err.Raise Number:=42, Description:="Select Case Error"
        End Select
    End If
End With

'Dump the data into the spreadsheet
'----------------------------------------------------------------------
Dim rngOutput As Range: Set rngOutput = wksOutput.Range("A1").Resize(intSize + 1, 5)
rngOutput.EntireColumn.Clear
rngOutput.Value2 = Application.Transpose(arrNames)

'Create a table from the names
'----------------------------------------------------------------------
Dim tblNames As Object
Set tblNames = wksOutput.ListObjects.Add(xlSrcRange, rngOutput, , xlYes)
tblNames.Name = "Table_" & strName

End Sub