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

JTannas

New Member
Joined
Mar 8, 2010
Messages
29
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:
Code:
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.
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
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:

Code:
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

New Member
Joined
Mar 8, 2010
Messages
29
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.
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,666
Messages
5,597,456
Members
414,145
Latest member
lonnie451

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top