Results 1 to 4 of 4
  1. #1
    2 Star Lounger
    Join Date
    Aug 2001
    Posts
    116
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Parameter Array (Excel 2000/SR-1)

    I'm trying to create a parameter array that can feed the resulting paramenter into a query table statement.
    This is what I have so far:
    <pre>Sub test()
    Dim FileToOpen As Variant
    Dim myFileName, ImportRangeName As String
    Dim myFileNameLength, NumColumns, NumRows, Counter1 As Integer

    'locate file with information
    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FileToOpen <> False Then
    'extract filename
    myFileName = Dir(FileToOpen)
    End If
    'extract firstpart of filename
    myFileNameLength = Application.WorksheetFunction.Find(".txt", myFileName)
    ImportRangeName = Application.WorksheetFunction.Replace(myFileName, myFileNameLength, 4, "")
    ' make field for connection
    FileToOpen = "TEXT;" & FileToOpen

    With ActiveSheet.QueryTables.Add(Connection:=FileToOpen , Destination:=Range("A1"))
    .Name = ImportRangeName
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = CreateArray(NumColumns)
    .Refresh BackgroundQuery:=False
    End With

    End Sub

    Private Function CreateArray(ParamArray ArrayData())
    Dim NumColumns, Counter1 As Integer
    NumColumns = Application.InputBox("How many columns are in this file?", , , , , , , 1)
    For Counter1 = 0 To UBound(ArrayData())
    ArrayData(Counter1) = 1
    Next Counter1

    End Function

    </pre>



    However, it is failing to create the array at the
    .TextFileColumnDataTypes = CreateArray(NumColumns)
    setting.

    I'm not sure how I'd test that the array is actually being created?

    Suggestions?

    Thanks

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Parameter Array (Excel 2000/SR-1)

    Your function CreateArray doesn't return anything, and you must ReDim the array (I think). Therefore I moved the InputBox call to the Test procedure. Note that CreateArray is a procedure now, with ArrayData as ByRef argument.

    Remark: a declaration like

    Dim myFileNameLength, NumColumns, NumRows, Counter1 As Integer

    means that Counter1 is an integer, while myFileNameLength, NumColumns and NumRows are variants. In VB, you must declare the type of each variable individually. This is a treacherous and regrettable idiosyncracy of VB - in other programming languages you have to define the type only once in a declaration statement.

    <img src=/w3timages/blueline.gif width=33% height=2>

    Sub test()
    Dim FileToOpen As Variant
    Dim myFileName, ImportRangeName As String
    Dim myFileNameLength, NumColumns, NumRows, Counter1 As Integer
    Dim a() As Integer

    'locate file with information
    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FileToOpen <> False Then
    'extract filename
    myFileName = Dir(FileToOpen)
    End If
    'extract firstpart of filename
    myFileNameLength = Application.WorksheetFunction.Find(".txt", myFileName)
    ImportRangeName = Application.WorksheetFunction.Replace(myFileName, myFileNameLength, 4, "")
    ' make field for connection
    FileToOpen = "TEXT;" & FileToOpen

    With ActiveSheet.QueryTables.Add(Connection:=FileToOpen , Destination:=Range("A1"))
    .Name = ImportRangeName
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    NumColumns = Application.InputBox("How many columns are in this file?", , , , , , , 1)
    ReDim a(0 To NumColumns - 1)
    CreateArray a
    .TextFileColumnDataTypes = a
    .Refresh BackgroundQuery:=False
    End With
    End Sub

    Private Sub CreateArray(ArrayData() As Integer)
    Dim NumColumns, Counter1 As Integer
    For Counter1 = 0 To UBound(ArrayData())
    ArrayData(Counter1) = xlGeneralFormat
    Next Counter1
    End Sub

    <img src=/w3timages/blueline.gif width=33% height=2>

  3. #3
    2 Star Lounger
    Join Date
    Aug 2001
    Posts
    116
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Parameter Array (Excel 2000/SR-1)

    Thanks for your help. I ended up not using a parameter array after all. - I guess I'll save that for another day.
    This is what I ended up with ...
    <img src=/w3timages/redline.gif width=33% height=2>
    Option Base 1
    Sub PlusSizeColumnImport()
    Dim SheetName As String
    Dim FileWithData As Variant
    Dim NumColumns, NumRows, Counter, Counter1, Counter2, NumSheets, SCount, SheetCounter, NxtSheet As Integer
    Dim myArray() As Variant
    Dim ActColumn(2), SkpColumn(4)
    Dim OpeningMsg, Style, Title, Reponse As String

    'opening Message
    OpeningMsg = "Do you wish to import a tab delimited text file?" & Chr(13) & Chr(13) & _
    "This file can have more than 256 Columns, but can not have more than 65,536 rows." & Chr(13) & _
    "Maximum columns is 64,000. A new file will be opened for the data"
    Style = vbOKCancel
    Title = "Do you wish to proceed?"
    response = MsgBox(OpeningMsg, Style, Title)
    If response = vbOK Then
    GoTo Start
    Else
    GoTo Finish
    End If

    Start:
    'locate file with information
    FileWithData = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If FileWithData <> False Then
    ' make field for connection
    FileWithData = "TEXT;" & FileWithData
    End If

    'Get dimensions of file to import
    NumColumns = Application.InputBox("How many columns are in this file?", "Enter Columns", , , , , , 1)
    'open new workbook
    Workbooks.Add
    'count the number of sheets necessary in the workbook
    'this will place up to 250 columns on a sheet
    NumSheets = Application.WorksheetFunction.RoundUp(NumColumns / 250, 0)
    SCount = Worksheets.Count
    'add more sheets if neccessary
    Counter = NumSheets - SCount
    If Counter > 0 Then
    For Counter2 = 1 To Counter
    Worksheets.Add after:=Sheets(Sheets.Count)
    Next Counter2
    Sheets("Sheet1").Select
    End If
    'set values for active column start range ActColumn(1) and end range ActColumn(2). ActColumn(1)
    'is negative at this point because it will be incremented later on.
    ActColumn(1) = -249
    ActColumn(2) = 0

    'counting from 1 to total number of sheets
    For SheetCounter = 1 To NumSheets
    'increment active column range for each sheet
    ActColumn(1) = ActColumn(1) + 250
    ActColumn(2) = ActColumn(2) + 250

    'sets the end of the active column range to be no greater than the total number of columns
    If ActColumn(2) > NumColumns Then
    ActColumn(2) = NumColumns
    End If

    'set the inactive column ranges, on the first pass SkpColumn(1) and SkpColumn(2) will be inactive
    SkpColumn(1) = ActColumn(1) - 250
    SkpColumn(2) = ActColumn(1) - 1
    SkpColumn(3) = ActColumn(2) + 1
    SkpColumn(4) = NumColumns

    'sets the first skipped column value to be no greater than 1
    If SkpColumn(1) > 1 Then
    SkpColumn(1) = 1
    End If

    'create array for textfileimport
    'set the size of the array to equal the number of columns
    ReDim myArray(NumColumns)
    'In MyArray set the active column values to 1 and skipped columns to 9, then the MyArray is used
    'the QueryTable section that follows.
    For Counter1 = ActColumn(1) To ActColumn(2)
    myArray(Counter1) = 1
    Next Counter1
    If SkpColumn(3) < NumColumns Then
    For Counter1 = SkpColumn(3) To SkpColumn(4)
    myArray(Counter1) = 9
    Next Counter1
    End If
    If SkpColumn(1) > 0 Then
    For Counter1 = SkpColumn(1) To SkpColumn(2)
    myArray(Counter1) = 9
    Next Counter1
    End If
    'QueryTable import
    With ActiveSheet.QueryTables.Add(Connection:=FileWithDa ta, Destination:=Range("B1"))
    .Name = ImportRangeName
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(myArray)
    .Refresh BackgroundQuery:=False
    End With
    'This deletes the first name in the workbook THERE SHOULDN'T BE ANY NAMES IN AN EMPTY WORKBOOK!
    ActiveWorkbook.Names(1).Delete
    If NxtSheet < NumSheets Then
    NxtSheet = SheetCounter + 1
    SheetName = "Sheet" & NxtSheet
    Sheets(SheetName).Select
    End If
    Next SheetCounter

    Finish:
    End Sub
    <img src=/w3timages/redline.gif width=33% height=2>

  4. #4
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Weert, Limburg, Netherlands
    Posts
    4,812
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Parameter Array (Excel 2000/SR-1)

    Hi Threesome <g>,

    Your function does not work because you failed to assign the result to the function

    This seems to work:

    Option Explicit

    <pre>Private Function CreateArray() As Variant
    Dim NumColumns, Counter1 As Integer
    Dim ArrayData() As Integer
    ReDim ArrayData(1)
    NumColumns = Application.InputBox("How many columns are in this file?", , , , , , , 1)
    For Counter1 = 0 To NumColumns-1
    ReDim Preserve ArrayData(Counter1)
    ArrayData(Counter1) = 1
    Next Counter1
    'Now assign the resulting array to the function's name so it will be returned:
    CreateArray = ArrayData
    End Function

    Sub test()
    Dim vArray As Variant
    Dim iCount As Integer
    vArray = CreateArray
    For iCount = 1 To UBound(vArray)
    MsgBox vArray(iCount)
    Next
    End Sub
    </pre>

    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    www.jkp-ads.com
    Professional Office Developers Association

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •