Consulting

Results 1 to 15 of 15

Thread: Fixed width import - remove trailing empty columns

  1. #1
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location

    Fixed width import - remove trailing empty columns

    Hey

    I have created a form where I can enter lengths of up to 40 fields to import from text a fixed width data file
    Even though the data file I am importing is 14 fields, excel is opening columns up to XFC, so making the opening process very long

    Below is part of the current VBA code I have created. (Site wont let me paste it all!)
    I would like to only import the fields specified in the user form, not every possible blank field excel can add to the end!
    Any help would be appreciated

    Public Function GetLastColumnNumber(ByVal ws As Worksheet) As Long
    On Error GoTo handler
    GetLastColumnNumber = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    GoTo finish 
    handler:
    finish:
    Call Cells.Find("", , XlFindLookIn.xlValues, XlLookAt.xlPart, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext)
    End Function
    
    Public Function GetLastRowNumber(ByVal ws As Worksheet) As Long
    On Error GoTo handler
    GetLastRowNumber = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        GoTo finish
    handler:
    finish:
        Call Cells.Find("", , XlFindLookIn.xlValues, XlLookAt.xlPart, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext)
    End Function
    Last edited by Aussiebear; 10-26-2023 at 12:32 PM. Reason: Added code tags to supplied code

  2. #2
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Other code
    Public Function GetExtension(ByVal file As String) As String
    On Error Resume Next
    Dim ext As String
    ext = ""
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    ext = "." & fso.GetExtensionName(file)
    finish:
    On Error GoTo 0
    GetExtension = ext
    End Function
    
    Sub SetDefaultBrowseLocation()
    On Error Resume Next
    Dim pathStr As String
    pathStr = "P:\Data Processing\Jobs"
    ChDrive (pathStr)
    ChDir (pathStr)
    On Error GoTo 0
    End Sub
    Last edited by Aussiebear; 10-26-2023 at 12:33 PM. Reason: Added code tags to supplied code

  3. #3
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Other code
    One big sub, part 1
    Sub MergedFixedWidthImport()
    'Stops the screen updating whilst processing and importing from text
    Application.ScreenUpdating = False
    'Declarations
    Dim previousName As String
    Dim newName As String
    previousName = ""
    newName = ""
    Dim myName As String
    Dim tempName As String
    Dim FName As String
    Dim myFile
    Dim MyPath
    Dim delimStr As String
    Dim ftStr As String
    Dim ext As String
    Dim strFileToOpen
    Dim tq As XlTextQualifier
    tq = xlTextQualifierDoubleQuote
    Dim lastRow As Long
    Dim lastCol As Long
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim flagCol As Long
    Dim encoding As Long
    Dim tqConsec As Boolean
    tqConsec = False
    Dim autoFitCol As Boolean
    autoFitCol = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    encoding = 1252
    'Setup array to hold 100000 long variables and set all of them to 2 for the text import (sets the column data type to xlTextFormat)
    Dim colDataTypesArr(1 To 100000) As Long
    Dim i As Long
    For i = 1 To UBound(colDataTypesArr)
        colDataTypesArr(i) = 2
    Next i
    Call SetDefaultBrowseLocation
    On Error GoTo finish
    Last edited by Aussiebear; 10-26-2023 at 12:34 PM. Reason: Added code tags to supplied code

  4. #4
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Part 2
    'Pick up the fixed width column lengths from the worksheet
    Dim colWidthsArr() As Long
    Dim widthCell As Range
    Dim counter As Long
    counter = 0
    For Each widthCell In ThisWorkbook.Sheets("Setup").Range("B2:B100").Cells
        If IsNumeric(widthCell.Value) = False Or widthCell.Value <= 0 Or widthCell.Value = vbNullString Then
           GoTo continueFromLoop
        End If
        If IsNumeric(widthCell.Value) And widthCell.Value > 0 Then
            ReDim Preserve colWidthsArr(counter)
            colWidthsArr(counter) = widthCell.Value
            counter = counter + 1
        End If
    Next widthCell
    continueFromLoop:
    If counter = 0 Then GoTo finish
        'Open as multifile code
        'Open the file dialog box to allow the user to choose files to open
        Set MyPath = Application.FileDialog(msoFileDialogFilePicker)
        'Set the properties of the open file dialog
        MyPath.Title = "Please choose " & "fixed width" & " files to open"
        MyPath.Filters.Clear
        MyPath.Filters.Add ftStr, ext
        MyPath.Filters.Add "All files", "*.*"
    Last edited by Aussiebear; 10-26-2023 at 12:35 PM. Reason: Added code tags to supplied code

  5. #5
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Part 3
    'Show the open file dialog
    If MyPath.Show Then
        'set allow multiselect to true
        MyPath.AllowMultiSelect = True
        Set newbook = Workbooks.Add
        newbook.Activate
        'Set the active sheet cells to text format before importing
        ActiveSheet.Cells.NumberFormat = "at sign (forum blocking)"
        For Each strFileToOpen In MyPath.SelectedItems
            'Test if the user has selected anything and if not go to finish
            If strFileToOpen = "" Or strFileToOpen = "False" Then
                 GoTo finish
            End If
            On Error GoTo finish
            lastRow = Module1.GetLastRowNumber(newbook.Sheets(1))
            Set myFile = fso.GetFile(strFileToOpen)
    Last edited by Aussiebear; 10-26-2023 at 12:37 PM. Reason: Added code tags to supplied code

  6. #6
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Part 4 and end
    'Add the querytable to the active sheet and open the user selected file as text using the "TEXT;" qualifier before the filepath
                With ActiveSheet.QueryTables.Add( _
                    Connection:="TEXT;" & strFileToOpen, _
                    Destination:=newbook.Sheets(1).Range(Cells(lastRow + 1, 1).Address))
                    'Set the properties of the QueryTable
                    .Name = "Sheet1"
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = autoFitCol
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = encoding
                    .TextFileStartRow = 1
                    .TextFileParseType = xlFixedWidth
                    .TextFileTextQualifier = tq
                    .TextFileConsecutiveDelimiter = tqConsec
                    .TextFileTabDelimiter = True
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    'User defined column widths variable used below
                    .TextFileFixedColumnWidths = colWidthsArr
                    'The below line will use the array that was set up above and will do the equivalent of hilighting all columns and setting them to text
                    .TextFileColumnDataTypes = colDataTypesArr
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
    Next
    If autoFitCol = True Then
                newbook.Sheets(1).Columns.AutoFit
            End If
    End If
    GoTo finish
    sheetHandler:
        MsgBox "Problem with active sheet"
        GoTo finish
    sheetNameHandler:
        MsgBox "Sheet name already exists in this workbook." & vbNewLine & "Please try again and select to open in a new workbook."
        GoTo finish
    'On finish - turn the screen updating back on
    finish:
        Application.ScreenUpdating = True
    End Sub
    Last edited by Aussiebear; 10-26-2023 at 12:38 PM. Reason: Added code tags to supplied code

  7. #7
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    If an admin can move this to excel section not outlook... my apologies

  8. #8
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,180
    Location
    Welcome to VBAX NickWels. Admin have set it up so no one can flood the forum with their first few posts. Apologies accepted for posting in the wrong subform, and you will notice.... you should wrap your code with code tags.....
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  9. #9
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    thanks, wasn't aware but noted for future

  10. #10
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Can anyone help?!
    Short version... how to limit impot of columns to what you have selected using a user form, not max amount possible in excel

  11. #11
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,180
    Location
    As I understand it this is all of your code. I find it difficult to concentrate on linking code written in different posts
    Public Function GetLastColumnNumber(ByVal ws As Worksheet) As Long
    On Error GoTo handler
    GetLastColumnNumber = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    GoTo finish 
    handler:
    finish:
    Call Cells.Find("", , XlFindLookIn.xlValues, XlLookAt.xlPart, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext)
    End Function
     
    Public Function GetLastRowNumber(ByVal ws As Worksheet) As Long
    On Error GoTo handler
    GetLastRowNumber = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    GoTo finish
    handler:
    finish:
    Call Cells.Find("", , XlFindLookIn.xlValues, XlLookAt.xlPart, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext)
    End Function
     
    Public Function GetExtension(ByVal file As String) As String
    On Error Resume Next
    Dim ext As String
    ext = ""
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    ext = "." & fso.GetExtensionName(file)
    finish:
    On Error GoTo 0
    GetExtension = ext
    End Function
     
    Sub SetDefaultBrowseLocation()
    On Error Resume Next
    Dim pathStr As String
    pathStr = "P:\Data Processing\Jobs"
    ChDrive (pathStr)
    ChDir (pathStr)
    On Error GoTo 0
    End Sub
     
    Sub MergedFixedWidthImport()
    'Stops the screen updating whilst processing and importing from text
    Application.ScreenUpdating = False
    'Declarations
    Dim previousName As String
    Dim newName As String
    previousName = ""
    newName = ""
    Dim myName As String
    Dim tempName As String
    Dim FName As String
    Dim myFile
    Dim MyPath
    Dim delimStr As String
    Dim ftStr As String
    Dim ext As String
    Dim strFileToOpen
    Dim tq As XlTextQualifier
    tq = xlTextQualifierDoubleQuote
    Dim lastRow As Long
    Dim lastCol As Long
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim flagCol As Long
    Dim encoding As Long
    Dim tqConsec As Boolean
    tqConsec = False
    Dim autoFitCol As Boolean
    autoFitCol = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    encoding = 1252
    'Setup array to hold 100000 long variables and set all of them to 2 for the text import (sets the column data type to xlTextFormat)
    Dim colDataTypesArr(1 To 100000) As Long
    Dim i As Long
    For i = 1 To UBound(colDataTypesArr)
        colDataTypesArr(i) = 2
    Next i
    Call SetDefaultBrowseLocation
    On Error GoTo finish
     'Pick up the fixed width column lengths from the worksheet
    Dim colWidthsArr() As Long
    Dim widthCell As Range
    Dim counter As Long
    counter = 0
    For Each widthCell In ThisWorkbook.Sheets("Setup").Range("B2:B100").Cells
        If IsNumeric(widthCell.Value) = False Or widthCell.Value <= 0 Or widthCell.Value = vbNullString Then
           GoTo continueFromLoop
        End If
        If IsNumeric(widthCell.Value) And widthCell.Value > 0 Then
            ReDim Preserve colWidthsArr(counter)
            colWidthsArr(counter) = widthCell.Value
            counter = counter + 1
        End If
    Next widthCell
    continueFromLoop:
    If counter = 0 Then GoTo finish
        'Open as multifile code
        'Open the file dialog box to allow the user to choose files to open
        Set MyPath = Application.FileDialog(msoFileDialogFilePicker)
        'Set the properties of the open file dialog
        MyPath.Title = "Please choose " & "fixed width" & " files to open"
        MyPath.Filters.Clear
        MyPath.Filters.Add ftStr, ext
        MyPath.Filters.Add "All files", "*.*"
    'Show the open file dialog
    If MyPath.Show Then
        'set allow multiselect to true
        MyPath.AllowMultiSelect = True
        Set newbook = Workbooks.Add
        newbook.Activate
        'Set the active sheet cells to text format before importing
        ActiveSheet.Cells.NumberFormat = "at sign (forum blocking)"
        For Each strFileToOpen In MyPath.SelectedItems
            'Test if the user has selected anything and if not go to finish
            If strFileToOpen = "" Or strFileToOpen = "False" Then
                 GoTo finish
            End If
            On Error GoTo finish
            lastRow = Module1.GetLastRowNumber(newbook.Sheets(1))
            Set myFile = fso.GetFile(strFileToOpen)
            'Add the querytable to the active sheet and open the user selected file as text using the "TEXT;" qualifier before the filepath
            With ActiveSheet.QueryTables.Add( _
                 Connection:="TEXT;" & strFileToOpen, _
                 Destination:=newbook.Sheets(1).Range(Cells(lastRow + 1, 1).Address))
                 'Set the properties of the QueryTable
                 .Name = "Sheet1"
                 .FieldNames = True
                 .RowNumbers = False
                 .FillAdjacentFormulas = False
                 .PreserveFormatting = True
                 .RefreshOnFileOpen = False
                 .RefreshStyle = xlInsertDeleteCells
                 .SavePassword = False
                 .SaveData = True
                 .AdjustColumnWidth = autoFitCol
                 .RefreshPeriod = 0
                 .TextFilePromptOnRefresh = False
                 .TextFilePlatform = encoding
                 .TextFileStartRow = 1
                 .TextFileParseType = xlFixedWidth
                 .TextFileTextQualifier = tq
                 .TextFileConsecutiveDelimiter = tqConsec
                 .TextFileTabDelimiter = True
                 .TextFileSemicolonDelimiter = False
                 .TextFileCommaDelimiter = False
                 .TextFileSpaceDelimiter = False
                 'User defined column widths variable used below
                 .TextFileFixedColumnWidths = colWidthsArr
                 'The below line will use the array that was set up above and will do the equivalent of highlighting all columns and setting them to text
                 .TextFileColumnDataTypes = colDataTypesArr
                 .TextFileTrailingMinusNumbers = True
                 .Refresh BackgroundQuery:=False
            End With
        Next
        If autoFitCol = True Then
            newbook.Sheets(1).Columns.AutoFit
        End If
    End If
    GoTo finish
    sheetHandler:
    MsgBox "Problem with active sheet"
    GoTo finish
    sheetNameHandler:
    MsgBox "Sheet name already exists in this workbook." & vbNewLine & "Please try again and select to open in a new workbook."
    GoTo finish
    'On finish - turn the screen updating back on
    finish:
    Application.ScreenUpdating = True
    End Sub
    Maybe this will assist other to peruse your code. Everyone codes differently, however some of my immediate queries are;
    1. The use of double error handlers in blocks of code. Is this necessary?
    2. Your use of "Dim fso" but don't actually dim it as anything. Is that good code practise?
    3. Your use of "Handler:" but don't actually use it. Can it be deleted?
    4. Your use of "ext = """, but then three lines later actually set the "ext = "." & fso.GetExtensionName(file)". Are you over complicating the code?
    5. Your setting of fso "Set fso = CreateObject("Scripting.FileSystemObject") twice within 8 lines. Is this necessary?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  12. #12
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,910
    1. I'm not sure this line:
    ActiveSheet.Cells.NumberFormat = "@"
    is necessary since you've set an array and used it in the query:
    .TextFileColumnDataTypes = colDataTypesArr
    but it's not easy for me to test. Could you?
    That first line sets ALL cells on the sheet, all 17,179,869,184 of them to text format and I think this might take up some time but I could be wrong.

    2. Your colDataTypesArr has 100,000 members; does it need to be so big? and how long does the query take to add that property? and does it even cope with the difference between the number of columns being imported and the size of that array?
    Perhaps reduce its size to 40 (from your 'I can enter lengths of up to 40 fields') or 99 (the number of cells in B2:B100)?
    Last edited by p45cal; 10-30-2023 at 04:30 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  13. #13
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Thanks for the help. I have made both changes, the speed to import is now almost instant which is great!!
    All imported fields are correct.
    But i now also have all original data, still fixed width in Col CV
    This wasn't happening before. Any ideas?
    Attached Images Attached Images

  14. #14
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,910
    Progress is being made, but it looks like you're struggling a bit with the code. So it looks like you've researched how to do what you want and want to adapt code you've found on the web.
    The code sets some values and arrays for the Querytable to do its import job properly; you want to import a fixed width text file and you want to tell it (a) the columns layout of the text file (the column widths, your colWidthsArr) and (b) the type of data in those columns (your colDataTypesArr) so that Excel correctly interprets that data. These two go hand in hand.
    Have a look at https://learn.microsoft.com/en-us/of...edColumnWidths where you'll note 2 things: 'If you specify columns that exceed the width of the text file, those values are ignored.' and 'If the width of the text file is greater than the total width of columns that you specify, the balance of the text file is imported into an additional column.'
    This looks to be the case for you, and what needs to happen is for that last column not to be imported.

    Also have a look at https://learn.microsoft.com/en-us/of...olumnDataTypes noting 'Use the XlColumnDataType constants to specify' where the XlColumnDataType links to https://learn.microsoft.com/en-us/of...columndatatype which shows how you've used the value 2 (xlTextFormat) to import as text for all your fields, but note there's also 9 (xlSkipColumn) to say that the column is not parsed (it's skipped), which is probably what you want.
    So lets say you have a text file with an overall width of 100 characters, you want to import the first 3 columns only, of widths:
    (5,10,5)
    which totals only 20 characters. You specify that they're all to come in as Text so you set up your colDataTypesArr to contain:
    (2,2,2)
    If you run with that you'll get your 3 columns brought in properly, but you'll get the balance (80 characters wide) in a fourth column with the default General type. I think this is what you're seeing in column CV. What I think you want to do is to add a 4th xlSkipColumn element to handle that 4th column by adding a 4th element to your colDataTypesArr making it:
    (2,2,2,9)

    I suspect the learning curve is a little steep, especially if you're in a hurry for this to work. There's a fair amount of code that you probably don't need, and some of it needs rearranging so that your column widths and column types tally properly, depending on how far your data goes down in column B of the Setup sheet.

    I'll offer to write some of this code for you but I see that you don't want some data to be in the public domain, however, if you don't mind just me seeing it I would need your workbook (bare bones just for this project preferably) and one or two samples of untouched text files for import.
    Send me a Private Message here if you want to go ahead with that, otherwise we can progress in baby steps here, but it might take some time.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  15. #15
    VBAX Regular
    Joined
    Oct 2023
    Posts
    11
    Location
    Thank you for the extensive reply. I will read through all the links you have added and will reach out if I need any help

Posting Permissions

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