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 ).
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
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
"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
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
'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
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If
TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)
If IsArray(TxtFileNames) Then
On Error GoTo CleanUP
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
.ScreenUpdating = False
.EnableEvents = False
End With
'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)
Set basebook = Workbooks.Add(xlWBATWorksheet)
'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)
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
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
"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)
.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
'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
.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
On Error Resume Next
Application.DisplayAlerts = False
basebook.Worksheets(1).Delete
Application.DisplayAlerts = True
On Error GoTo 0
CleanUP:
ChDirNet SaveDriveDir
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
.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