Macro Needed to import .txt file with no delimiters to excel spreadsheet

Antoszewskim

New Member
Joined
Jan 26, 2011
Messages
1
Macro needed. On a daily basis I receive a very ugly text file that I need to convert into an excel spreadsheet to analyze charges. I open the file with Excel and since there are no delimiters I create the columns using the fixed width option. Once in a spreadsheet, I need to delete a line, clean up some column headers, then sort on a particular column looking for charges that meet a criteria (Filter where value = P). Same process everyday...so I thought I would try a macro to simplify the repetitive steps. I searched the internet and found something that I almost got to work. My problem now is that if the text file is large (probably over 50,000 rows) the entire spreadsheet is not created.
Can anyone tell me why? I thought with excel 2007 that rows limit in a spreadsheet is now 1,048,576. Might it have something to do with my somewhat ugly macro? I am a pharmacist who has found myself in a new IT position and I know very little about creating macros or writing code (as if you can't you tell by the macro that follows....or this post ).

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function


 
Sub Get_TXT_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim mysheet As Worksheet
Dim basebook As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet("P:\PharmNet Charge Discrepancies")
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUP

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)

'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

'Add a new worksheet for the name of the txt file
Set mysheet = Worksheets.Add(After:=basebook. _
Sheets(basebook.Sheets.Count))
On Error Resume Next
mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
InStrRev(TxtFileNames(Fnum), "\", , 1))
On Error GoTo 0

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1


.TextFileParseType = xlFixedWidth

'Set the width for each column
.TextFileFixedColumnWidths = Array(13, 25, 8, 7, 6, 2, 1, 4)
'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2)

'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

' Get the data from the txt file
.Refresh BackgroundQuery:=False
End With
ActiveSheet.QueryTables(1).Delete
Next Fnum

'Delete the first sheet of basebook
On Error Resume Next
Application.DisplayAlerts = False
basebook.Worksheets(1).Delete
Application.DisplayAlerts = True
On Error GoTo 0

CleanUP:
ChDirNet SaveDriveDir

With Application
.ScreenUpdating = True
.EnableEvents = True
Rows("5:5").Select
Selection.Delete Shift:=xlUp
Range("C4").Select
ActiveCell.FormulaR1C1 = "CDM"
Range("D4").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("E4").Select
ActiveCell.FormulaR1C1 = "SVC DATE"
Range("F4").Select
ActiveCell.FormulaR1C1 = "CH/CR"
Range("G4").Select
ActiveCell.FormulaR1C1 = "PAV"
Range("H4").Select
ActiveCell.FormulaR1C1 = "LOC"
Range("I4").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "REASON"
Range("B2").Select
ActiveCell.FormulaR1C1 = "PHARMMNET RX CHARGE INTERFACE"
Range("A2").Select
ActiveCell.FormulaR1C1 = "SUBJECT: "
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=-9
ActiveWindow.ScrollRow = 1
Columns("A:A").Select
Selection.NumberFormat = "0"
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$64487").AutoFilter Field:=7, Criteria1:="P"
End With
End If
End Sub

 
 
 
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Forum statistics

Threads
1,215,873
Messages
6,127,454
Members
449,383
Latest member
DonnaRisso

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
Back
Top