.TXT Import - Limit Cell Contents Length

Ahernech

New Member
Joined
Sep 19, 2008
Messages
18
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 :) :

Code:
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:

Code:
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!
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Cbrine

Well-known Member
Joined
Dec 2, 2003
Messages
3,196
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.
Code:
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

New Member
Joined
Sep 19, 2008
Messages
18
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:
Code:
ws.cells(i,1)=left(LineArrary(0),40)

etc.

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

Ahernech

New Member
Joined
Sep 19, 2008
Messages
18
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 :eek:
 

Cbrine

Well-known Member
Joined
Dec 2, 2003
Messages
3,196
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,518
Messages
5,596,630
Members
414,082
Latest member
sasmita

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top