"Subscript out of range" when used in Loop

[Halkyon]

Hi folks,

I did look at the other threads about this but couldn't find an answer within.

My situation is as follows. I have a sheet that generates a list of file names to be imported into different sheets, I'm writing code to loop through the sheets and import them all into each (each list of files is in a different column named after the sheet the files will be imported into). I think I've got my head around most of it, but when my macro gets to the import stage it says "subscript out of range" on the array that holds all the file names (DataFiles).

This part of my code that highlights when I hit debug.

For DFCounter = 0 To NoOfProducts

[COLOR=SeaGreen]'File Import/Data Connection[/COLOR]
With ActiveSheet.QueryTables.Add(Connection:= _
   "TEXT;Macintosh HD:Users:user:path:" & DataFiles(DFCounter) & ".csv", _
   Destination:=ImportTarget)
  .LotsOfProperties = Variables
End With

This is how the array is populated:

With Sheets("Inputs_DataIDs").Range(DataColumns(SetCounter) & 2, DataColumns(SetCounter) & NoOfProducts + 1)
    ReDim DataFiles(0 To NoOfProducts)
    DataFiles = Range(DataColumns(SetCounter) & 2, DataColumns(SetCounter) & NoOfProducts + 1)
End With

My code worked before I used the With... function to populate the array, I was doing that manually before.

 

[Norie]

Could you post the exact code you have now?

Have you tested it to see what happens on each iteration/import?

 

[Halkyon]

Hope you had a good weekend Norie.

Sub Refresh_Data_Import_Structure()

[COLOR=SeaGreen]' TOGGLES[/COLOR]
Application.ScreenUpdating = False

[COLOR=SeaGreen]' DECLARATIONS[/COLOR]
Dim DataNames(1 To 8) As Variant
Dim DataColumns(1 To 8) As Variant
Dim DCounter As Long
Dim NoOfProds As Integer
Dim DataFiles As Variant
Dim DFCounter As Long
Dim ImportTarget As Range
Dim ActiveWS As Worksheet

[COLOR=SeaGreen]' FILL ARRAYS & SET BASIC VARIABLES
' Populate DataNames & DataColumns[/COLOR]
DataNames(1) = "DAU"
DataNames(2) = "WAU"
DataNames(3) = "MAU"
DataNames(4) = "NU"
DataNames(5) = "URtnd"
DataNames(6) = "Ssns"
DataNames(7) = "AvSsn"
DataNames(8) = "MdSsn"
DataColumns(1) = "H"
DataColumns(2) = "I"
DataColumns(3) = "J"
DataColumns(4) = "K"
DataColumns(5) = "L"
DataColumns(6) = "M"
DataColumns(7) = "N"
DataColumns(8) = "O"

[COLOR=SeaGreen]' Find number of real DataFiles and resize DataFiles array[/COLOR]
NoOfProds = Sheets("In_DataIDs").Range("A1").Offset(Rows.Count - 1, 0).End(xlUp).Row - 1 [COLOR=SeaGreen]' Minus one for header row[/COLOR]

[COLOR=SeaGreen]' Set the DCounter 'just in case'[/COLOR]
DCounter = 1

[COLOR=SeaGreen]' METRICS LOOP[/COLOR]
For DCounter = 1 To 8
    
    With Sheets("In_DataIDs").Range(DataColumns(DCounter) & 1, DataColumns(DCounter) & (NoOfProds + 1))
    ReDim DataFiles(1 To NoOfProds)
    DataFiles = .Range(DataColumns(DCounter) & 2, DataColumns(DCounter) & (NoOfProds + 1))
    End With
    
[COLOR=SeaGreen]    ' Select and Clear Sheet for Import[/COLOR]    
    Set ActiveWS = Sheets("In_Fl_" & DataNames(DCounter))
    ActiveWS.Cells.Delete
    
[COLOR=SeaGreen]    ' Set/Reset the ImportTarget & DataFile Counter[/COLOR]
    Set ImportTarget = ActiveWS.Range("A2")
    DFCounter = 1
    
[COLOR=SeaGreen]    ' DATAFILES LOOP[/COLOR]
    For DFCounter = 1 To NoOfProds

[COLOR=SeaGreen]        ' File Import & Data Connection[/COLOR]
        With ActiveWS.QueryTables.Add(Connection:= _
            "TEXT;Macintosh HD:Users:user:path:Reports:" & DataFiles(DFCounter, 1) & ".csv", _
            Destination:=ImportTarget)
                .Name = "Import_" & DataFiles(DFCounter, 1)
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .RefreshOnFileOpen = False
                .BackgroundQuery = False
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = xlMacintosh
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 5)
                .Refresh BackgroundQuery:=False
                .UseListObject = False
                End With
    
        Set ImportTarget = ImportTarget.Offset(0, 2)
    
    Next

[COLOR=SeaGreen]    ' ADD TITLES ABOVE COLUMNS[/COLOR]
 [COLOR=SeaGreen]   ' Reset position[/COLOR]
    Set ImportTarget = Range("A2")
[COLOR=SeaGreen]    ' Add text labels[/COLOR]
    For DFCounter = 1 To NoOfProds
        ImportTarget.Offset(-1, 0) = DataFiles(DFCounter, 1)
[COLOR=SeaGreen]        ' Move selection[/COLOR]
        Set ImportTarget = ImportTarget.Offset(0, 2)
    Next

Next

[COLOR=SeaGreen]' TOGGLES[/COLOR]
Application.ScreenUpdating = True

End Sub

Watcher on error:

DFCounter = 1
ActiveWS = In_Fl_WAU
DataFiles = Empty array
NoOfProds = 64
ImportTarget = 1,2 (A2)
DCounter = 2
DataColumns = Full array
DataNames = Full array

The first data sheet (DAU) is filled with the MdSsn Data (8), the second (WAU) is empty.

 

[Halkyon]

Updated the code a little in an attempt to make it more robust but has the same problem.

Sub Refresh_Import_Structure()

' TOGGLES
Application.ScreenUpdating = False

' DECLARATIONS
Dim DataNames(1 To 8) As Variant
Dim DataColumns(1 To 8) As Variant
Dim DataCounter As Integer
Dim DataFileNo As Integer
Dim DataFileFiles As Variant
Dim DFCounter As Integer
Dim ImportTarget As Range
Dim ActiveWS As Worksheet

' Populate DataNames & DataColumns
DataNames(1) = "DAU"
DataNames(2) = "WAU"
DataNames(3) = "MAU"
DataNames(4) = "NU"
DataNames(5) = "URtnd"
DataNames(6) = "Ssns"
DataNames(7) = "AvSsn"
DataNames(8) = "MdSsn"
DataColumns(1) = "H"
DataColumns(2) = "I"
DataColumns(3) = "J"
DataColumns(4) = "K"
DataColumns(5) = "L"
DataColumns(6) = "M"
DataColumns(7) = "N"
DataColumns(8) = "O"

' Find number of real DataFiles
DataFileNo = Sheets("In_DataIDs").Range("A1").Offset(Rows.Count - 1, 0).End(xlUp).Row - 1 ' Minus one for header row

' DATA SETS LOOP
For DataCounter = 1 To 8 Step 1

    With Sheets("In_DataIDs").Range(DataColumns(DataCounter) & 1, DataColumns(DataCounter) & (DataFileNo + 1))
    ReDim DataFileFiles(1 To DataFileNo, 1)
    DataFileFiles = .Range(DataColumns(DataCounter) & 2, DataColumns(DataCounter) & (DataFileNo + 1))
    End With
    
    Set ActiveWS = Sheets("In_Fl_" & DataNames(DataCounter))
    ActiveWS.Cells.Delete
    
    ' Set/Reset the ImportTarget & DataFile Counter
    Set ImportTarget = ActiveWS.Range("A2")
    
    ' DATAFILES LOOP
    For DFCounter = 1 To DataFileNo Step 1

        ' File Import & Data Connection
        With ActiveWS.QueryTables.Add(Connection:= _
            "TEXT;Macintosh HD:Users:user:path:" & DataFileFiles(DFCounter, 1) & ".csv", _
            Destination:=ImportTarget)
                .Name = "Import_" & DataFileFiles(DFCounter, 1)
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .RefreshOnFileOpen = False
                .BackgroundQuery = False
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = xlMacintosh
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 5)
                .Refresh BackgroundQuery:=False
                .UseListObject = False
                End With
    
        Set ImportTarget = ImportTarget.Offset(0, 2)
    
    Next DFCounter
    
    ' ADD TITLES ABOVE COLUMNS
    ' Reset position
    Set ImportTarget = ActiveWS.Range("A2")
    ' Add text labels
    For DFCounter = 1 To DataFileNo Step 1
    ImportTarget.Offset(-1, 0) = DataFileFiles(DFCounter, 1)
    ' Move selection
    Set ImportTarget = ImportTarget.Offset(0, 2)
    Next DFCounter

Next DataCounter

' TOGGLES
Application.ScreenUpdating = True

End Sub

 

[Norie]

So have you tested it by stepping through the code with F8?

In particular you should test it when it doesn't work.

eg if it doesn't work on the 3rd iteration, test that iteration

 

[Halkyon]

Right, I went through it line-by-line and it was the array populating With... function.

Despite the first line being:

With Sheets("In_DataIDs").Range(DataColumns(DataCounter) & 1, DataColumns(DataCounter) & (DataFileNo +1))

The line:

DataFiles = .Range(DataColumns(DataCounter) & 2, DataColumns(DataCounter) & (DataFileNo + 1))

... tried to fill the array from the active sheet, whether Range was preceeded by a . or not.

Changing the method of populating the array to just:

ReDim DataFiles(1 To DataFileNo, 1)
DataFiles = Sheets("In_DataIDs").Range(DataColumns(DataCounter) & 2, DataColumns(DataCounter) & (DataFileNo + 1))

Fixed the problem.

Now I need to find something else to do because I've pretty much automated myself out of a job! Thank you for all your help Norie.