Fill a Array Property with an range variable?

[Dan DeHaven]

I'm trying to create a automated/dynamic Text Import procedure and having trouble filling the array properties (.TextFileColumnDataTypes, .TextFileFixedColumnWidths) with range variables. I've named the ranges as this would be the ideal way to call them from code.

Here is the code:

Sub ImportText()

Dim WB As Workbook
Dim odWS As Worksheet
Dim fsuWS As Worksheet
Dim fd As FileDialog
Dim fcInt As Integer
Dim fcStr As String
Dim spAr() As Variant
Dim dtAr() As Variant
    Set WB = ThisWorkbook
    Set odWS = WB.Sheets.Add
    odWS.Name = "OriginalData"
    Set fsuWS = WB.Sheets("FieldSetUp")
    spAr = fsuWS.Range("SpanSpaces").Value
    dtAr = fsuWS.Range("ImpDataTypes").Value
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fcInt = fd.Show
    
    If fcInt <> -1 Then
        MsgBox "You chose cancel, why?"
    Else
        fcStr = fd.SelectedItems(1) & "."
    End If
    
    With odWS.QueryTables.Add(Connection:= _
        "TEXT;" & fcStr, Destination:=Range("$A$1"))
        .Name = "OriginalData"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = dtAr 'This way doesn't work
        .TextFileFixedColumnWidths = Array(spAr) 'Nor this way
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

So it's with the .TextFileColumnDataTypes and .TextFileFixedColumnWidths that I'm getting the Run-Time error 5 "Invalid procedure call or arguement".


Thanks!

 

[Dan DeHaven]

Figured this out, thought the solution may be helpful to others.

I realized the issue after reading documentation on VBA Arrays, they aren't stored like a column of data but rather they are like a row of data. I guess this should have been obvious but it didn't occur to me originally. Because the Range source of values that I wanted to feed to the variable was in a column I had to use "Transpose" to the Range reference before I loaded it to the property of the Method.

Here were the two lines of revised code:

spAr = Application.Transpose(fsuWS.Range("SpanSpaces").Value)
dtAr = Application.Transpose(fsuWS.Range("ImpDataTypes").Value)

 

[SandeepKumarMYVN]

Hi...
I am facing the similar problem as mentioned here. Can u provide the full code for it?
Like spAR declaration and other details.

 

[Dan DeHaven]

Sandeep,

Here is the complete code:

Sub ImportText()

'Automates the set-up of Fixed-Width Text file data
'By referencing a named range that contains the field sizes
'for each field, as well as the field types


Dim WB As Workbook
Dim odWS As Worksheet
Dim fsuWS As Worksheet
Dim fd As FileDialog
Dim fcInt As Integer
Dim fcStr As String
Dim spAr As Variant
Dim dtAr As Variant


    Set WB = ThisWorkbook
    Set odWS = WB.Sheets.Add
    odWS.Name = "OriginalData"
    Set fsuWS = WB.Sheets("FieldSetUp")
    
    'Transposing the range is essential for loading the values to the
    'Array properties below
    spAr = Application.Transpose(fsuWS.Range("SpanSpaces").Value)
    dtAr = Application.Transpose(fsuWS.Range("ImpDataTypes").Value)
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fcInt = fd.Show
    
    If fcInt <> -1 Then
        MsgBox "You chose cancel, why?"
    Else
        fcStr = fd.SelectedItems(1) & "."
    End If
    
    With odWS.QueryTables.Add(Connection:= _
        "TEXT;" & fcStr, Destination:=Range("$A$1"))
        .Name = "OriginalData"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(dtAr)
        .TextFileFixedColumnWidths = Array(spAr)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

The trick is to transpose the range prior to loading it into the variable.

Let me know if you're still having issues, feel free to send me your code.

Dan

 

[SandeepKumarMYVN]

Hi Dan,

Thanks for the Code.. But i am getting a "Invalid Procedure Call or Argument error" with my code. Please help:

Code:

Sub Individual_VipOut_Text_Import(trgt As String, strt_row As Integer, Driver As Boolean)
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim CW As Variant
    Dim CDT As Variant   
    Set WB = ThisWorkbook
    Set WS = WB.Sheets("Input")
    CW = Application.WorksheetFunction.Transpose(WS.Range("E1:E47").Value)
    CDT = Application.WorksheetFunction.Transpose(WS.Range("H1:H47").Value)
  
 
    If Driver Then
        '--First File goes in A1--
        Sheets("Target").Select
        Range("A1").Select
    Else
        '--Search for first empty row to import additional files--
        Sheets("Target").Activate
        Range("A1").Activate
        ActiveCell.End(xlDown).Offset(1, 0).Select
    End If
       
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & trgt, Destination:=ActiveCell)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = strt_row
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
   .TextFileParseType = xlFixedWidth
      'Set the width for each column
  .TextFileFixedColumnWidths = Array(CW)***
   .TextFileColumnDataTypes = Array(CDT)
 
        '--ColumnDataTypes--
        'xlGeneralFormat  General          1
        'xlTextFormat     Text             2
        'xlMDYFormat      Month-Day-Year   3
        'xlDMYFormat      Day-Month-Year   4
        'xlYMDFormat      Year-Month-Day   5
        'xlMYDFormat      Month-Year-Day   6
        'xlDYMFormat      Day-Year-Month   7
        'xlYDMFormat      Year-Day-Month   8
        'xlSkipColumn     Skip             9
   
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
    End With
   
End Sub

The error occurs at ***
Any ideas on this what causing the error..?
The Column Widths are stored in 'column E'
The column data types are stored in 'Column H' of Input worksheet in my workbook.

Regards,
Sandeep.

 

[netuser]

Sorry to bump this Old thread but I need to use this Code and i am getting same error as the person below Invalid Procedure Call or Argument error 5

What is causing this please ?

Thanks

Hi Dan,

Thanks for the Code.. But i am getting a "Invalid Procedure Call or Argument error" with my code. Please help:

Code:

Sub Individual_VipOut_Text_Import(trgt As String, strt_row As Integer, Driver As Boolean)
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim CW As Variant
    Dim CDT As Variant   
    Set WB = ThisWorkbook
    Set WS = WB.Sheets("Input")
    CW = Application.WorksheetFunction.Transpose(WS.Range("E1:E47").Value)
    CDT = Application.WorksheetFunction.Transpose(WS.Range("H1:H47").Value)
  
 
    If Driver Then
        '--First File goes in A1--
        Sheets("Target").Select
        Range("A1").Select
    Else
        '--Search for first empty row to import additional files--
        Sheets("Target").Activate
        Range("A1").Activate
        ActiveCell.End(xlDown).Offset(1, 0).Select
    End If
       
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & trgt, Destination:=ActiveCell)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = strt_row
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
   .TextFileParseType = xlFixedWidth
      'Set the width for each column
  .TextFileFixedColumnWidths = Array(CW)***
   .TextFileColumnDataTypes = Array(CDT)
 
        '--ColumnDataTypes--
        'xlGeneralFormat  General          1
        'xlTextFormat     Text             2
        'xlMDYFormat      Month-Day-Year   3
        'xlDMYFormat      Day-Month-Year   4
        'xlYMDFormat      Year-Month-Day   5
        'xlMYDFormat      Month-Year-Day   6
        'xlDYMFormat      Day-Year-Month   7
        'xlYDMFormat      Year-Day-Month   8
        'xlSkipColumn     Skip             9
   
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
    End With
   
End Sub

The error occurs at ***
Any ideas on this what causing the error..?
The Column Widths are stored in 'column E'
The column data types are stored in 'Column H' of Input worksheet in my workbook.

Regards,
Sandeep.