.TXT Import - Limit Cell Contents Length

[Ahernech]

Hi all,

I've been working away on trying to get a solution for this and have been scouring the message boards but can't quite find what I need.

I am currently running two macros, the first imports a text file into columns A to E (there are ~100k lines so it flips to Sheet 2 once the end of Sheet 1 is reached). Modified version of a macro I found on your great board :

Sub ImportBankfile()
 
    Application.ScreenUpdating = False
'   Calls BANKFILE.TXT and copies data as required
    Dim iFreeFile As Integer, i As Long, path As String, InputLine
    Dim ws As Worksheet, LineArray, t As Date
    t = Now
    Set ws = ActiveSheet
    Reset
    iFreeFile = FreeFile
    path = ThisWorkbook.path
    Open path & "\" & "BANKFILE.txt" For Input As #iFreeFile
    Application.ScreenUpdating = False
    i = 8
    Do While Not EOF(iFreeFile)
    Line Input #iFreeFile, InputLine
    LineArray = Split(InputLine, vbTab)
    ws.Range(Cells(i, 1), Cells(i, 5)).Value = LineArray
    i = i + 1
    If i > 65536 Then
        Sheets("Sheet2").Activate
        Set ws = ActiveSheet
        i = 9
    End If
    Loop
'   Saves the workbook and closes BANKFILE.TXT
    ThisWorkbook.Save
    Close #iFreeFile
'   Re-enables Screen Updating and returns a message box detailing how long it took to run
    Application.ScreenUpdating = True
    MsgBox "Time elapsed" & vbTab & Format(Now - t, "hh:mm:ss")
    End Sub

This macro takes ~10 minutes to run, which is manageable. However I then need to run a second macro to reduce the contents of any cells >40 characters to 40 characters. Here is what I am using, again sourced from the board and modified:

Sub Line_Format()
'   Disables ScreenUpdating - Records Current Time
    t = Now
    ccount = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants).Count
    Dim i As Long
 
'   Sheet - Limits the information in each cell to 40 characters
    Sheets("Sheet1").Activate
    For Each cell In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    With cell
        .Value = Left(cell.Value, 40)
    End With
    loopcount = loopcount + 1
    Application.StatusBar = "Processing...." & Format(loopcount / ccount, "0.0%") & " Complete"
    Next
'   Re-enables ScreenUpdating - MsgBox Advises Time Elapsed
    MsgBox "Time elapsed" & vbTab & Format(Now - t, "hh:mm:ss")
End Sub

This takes a hefty 30 minutes + to run on only one of the sheets!

I was wondering
a) Can I alter the first macro to limit the length of the text strings it copies in?
or
b) I there any way to speed up this slow second macro?

Any assistance is much appreciated!

 

[Cbrine]

OK, This is totally untested, since I don't have your datafile, so you will need to let me know if it works. Or what error you recieved.

Sub ImportBankfile()
 
    Application.ScreenUpdating = False
'   Calls BANKFILE.TXT and copies data as required
    Dim iFreeFile As Integer, i As Long, path As String, InputLine
    Dim ws As Worksheet, LineArray, t As Date
    t = Now
    Set ws = ActiveSheet
    Reset
    iFreeFile = FreeFile
    path = ThisWorkbook.path
    Open path & "\" & "BANKFILE.txt" For Input As #iFreeFile
    Application.ScreenUpdating = False
    i = 8
    Do While Not EOF(iFreeFile)
    Line Input #iFreeFile, InputLine
    LineArray = Split(InputLine, vbTab)
    ws.range(cells(i,1))=left(LineArrary(0),40)
    ws.range(cells(i,2))=left(LineArrary(1),40)
    ws.range(cells(i,3))=left(LineArrary(2),40)
    ws.range(cells(i,4))=left(LineArrary(3),40)
    ws.range(cells(i,5))=left(LineArrary(4),40)
    i = i + 1
    If i > 65536 Then
        Sheets("Sheet2").Activate
        Set ws = ActiveSheet
        i = 9
    End If
    Loop
'   Saves the workbook and closes BANKFILE.TXT
    ThisWorkbook.Save
    Close #iFreeFile
'   Re-enables Screen Updating and returns a message box detailing how long it took to run
    Application.ScreenUpdating = True
    MsgBox "Time elapsed" & vbTab & Format(Now - t, "hh:mm:ss")
    End Sub

 

[Ahernech]

Thanks very much for the reply Cbrine. I was thinking along those lines but had no idea how to phrase it!

I was receiving a Run-time error '1004'. Method 'Range' of object '_Worksheet' failed.

I just removed the Range from the code and set it straight to:

ws.cells(i,1)=left(LineArrary(0),40)

etc.

It's just running through this now, so will see how long it takes!

 

[Ahernech]

Ok, took ~45 minutes to run through, but the formatting is great.
I'll remove the references to edit columns 1 and 2, as this data will always be <40 chars. Hopefully that will speed it up, but I guess I'm still looking at ~30 minutes run time

 

[Cbrine]

I think about the only thing that I could think of that might speed things up, would be to use a textstream of the FSO as opposed to the file input method. I've never tested the speed different between the two methods, so I'm not sure if one is faster than the other though, so it would be a shot in the dark pretty much.