VBA code exits loop while calling macro from another workbook

Question

The below mentioned code reads data from a workbook and stores it in various arrays, then it enters a loop to open another workbook to enter values stored in the array in specific tabs and locations.

Once entered, it calls another subroutine form the newly opened workbook, subroutine runs fine (takes 2-3 mins) to run, but then code automatically exits the loop (I mean it doesn't open the next file in the loop). Is it because of the processing time of the called macro? I could use some insight regarding the issue, it would be very helpful. Thanks in advance :)

Public strFileName As String
Public strfilename2 As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim ws As Worksheet
    Dim Tabnames() As Variant
    Dim celladdress() As Variant
    Dim values() As Variant
    Dim tabcount As Integer
    Dim filecount As Integer
    Dim j As Integer
    Dim k As Integer
    Dim i As Integer

strListSheet = "Data_Specifics"

Sheets(strListSheet).Select
tabcount = WorksheetFunction.CountA(Rows(6)) - 1
filecount = WorksheetFunction.CountA(Columns(2)) - 4

ReDim Tabnames(0, 0 To tabcount - 1)
ReDim celladdress(0, 0 To tabcount - 1)
ReDim values(0 To filecount - 1, 0 To tabcount - 1)

For k = 0 To tabcount - 1
Tabnames(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(6, k + 4).Value
celladdress(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(7, k + 4).Value
Next k

For j = 0 To filecount - 1
    For k = 0 To tabcount - 1
        values(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(j + 9, k + 4).Value
    Next k
Next j
Range("B8").Select
i = -1

Set currentWB = ActiveWorkbook
Do While ActiveCell.Value <> ""

    strFileName = ActiveCell.Offset(1, 1)
    strfilename2 = ActiveCell.Offset(1, 0)

    Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=False
    Set dataWB = ActiveWorkbook

    i = i + 1
        For k = 0 To tabcount - 1
        Sheets(Tabnames(0, k)).Select
        Range(celladdress(0, k)).Select
        If values(i, k) <> "XXXXX" Then
        Selection.Value = values(i, k)
        Else
        End If
        Next k

        strfilename2 = "'" & strfilename2 & "'" & "!ValidateDataNew"
        Application.Run strfilename2
        dataWB.Close SaveChanges:=True

    currentWB.Activate
    Sheets(strListSheet).Select
    ActiveCell.Offset(1, 0).Select
    i = i
Loop
Exit Sub

End Sub

I suspect it's because you're using activecell in your loop but since you're opening other workbooks the cell is no longer active. Put Debug.Print ActiveCell.Value and open the immediate window; does the last value correspond to the last value in your list in column B? — Absinthe, Jun 11 '17 at 17:48
You really should look into [How to avoid using Select](https://stackoverflow.com/q/10714251/6535336) because there is a very good chance that it is causing the issues, but there is one other thing I can think of; if the code is stopping before the opened workbook gets closed then you may have an `End` statement in your other macro. Without seeing the relevant code, we can't tell. — YowE3K, Jun 11 '17 at 19:58
using activecell in a loop condition is asking for trouble. Instead use a counter and FULLY reference the cell you are working with. — Patrick Lepelletier, Jun 12 '17 at 09:22

score 0 · Answer 1 · answered Jun 12 '17 at 02:38

To make sure the error is coming from ValidateDataNew MACRO, let's first remove the possible errors you might have in Sub GetData code.

We should remove all the possible error you might get when using Select, Selection and ActiveCell. Instead, use fully qualified Range objects.

Replace your Do While ActiveCell.Value <> "" loop with the code below:

Dim lRow As Long

Set currentWB = ActiveWorkbook
lRow = 8 ' start scanning from row 8

' use a loop with fully qualifed range, not select
Do While currentWB.Worksheets(strListSheet).Range("B" & lRow).Value <> ""

    strFileName = currentWB.Worksheets(strListSheet).Range("B" & lRow).Offset(1, 1)
    strfilename2 = currentWB.Worksheets(strListSheet).Range("B" & lRow).Offset(1, 0)

    Set dataWB = Workbooks.Open(strFileName, UpdateLinks:=False, ReadOnly:=False)

    i = i + 1
    For k = 0 To tabcount - 1
        If values(i, k) <> "XXXXX" Then
            dataWB.Worksheets(Tabnames(0, k)).Range(celladdress(0, k)).Value = values(i, k)
        Else
        End If
    Next k

    strfilename2 = "'" & strfilename2 & "'" & "!ValidateDataNew"
    Application.Run strfilename2

    dataWB.Close SaveChanges:=True
    Set dataWB = Nothing

    lRow = lRow + 1 ' advance the row by 1
Loop

VBA code exits loop while calling macro from another workbook

1 Answers1