H
HaSt2307
To All,
I am trying to help a buddy via email, with Ron's help we fixed the
Workbooks.OpenText problem, but now we have an error at the
Selection.Sort Key1:=Range("A2") point. It has something to do with him
having Excel 2000 and me Excel 2003.
My tired eyes must be missing something that is different from 2000
to 2003, but I can't find it. I would appreciate the help.
Thanks
Harry
Sub ImportText()
Dim ImportWbk As Workbook
Dim newWbk As Workbook
'Using workbooks.opentext will import the file to a new workbook, so we
'process the imported data then copy it to desired workbook and sheet.
If InputBox("Please enter the password", "Password Needed") <> "*******"
Then
MsgBox ("Wrong Password!")
On Error GoTo 0
Exit Sub
Else
Set ImportWbk = ThisWorkbook
Application.ScreenUpdating = False
Sheets("Data").Select
Application.DisplayStatusBar = True
' makes sure that the statusbar is visible
Application.StatusBar = "Please wait while importing and cleaning
up data..."
' Adjusted Array(53,1) to (54,1)
myFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
'Origin:=437 changed to xlWindows fixed one problem for excel 2000
Workbooks.OpenText Filename:=myFile, _
Origin:=xlWindows, StartRow _
:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(5, 1), Array( _
12, 1), Array(44, 1), Array(47, 1), Array(54, 1), Array(64, 1),
Array(73, 1), Array(82, 1), _
Array(92, 1), Array(102, 1), Array(115, 1), Array(120, 1),
Array(130, 1))
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set newWbk = ActiveWorkbook
Cells.Select
Selection.Columns.AutoFit
'Insert Code to find and delete by product
Call DelByProd
'Insert Code to find and delete next area
Cells.Find(What:="CODE", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:= _
xlNext, MatchCase:=False).Activate ', SearchFormat:=False
Cells(ActiveCell.Row, 1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Code to select area for copy
Range("N5000").Select
Range(Selection, Cells(1)).Select
Selection.Copy
'Change for active worksheet
ActiveSheet.Paste Destination:=ImportWbk.Sheets("Data").Range("A1")
Application.CutCopyMode = False
'Set New workbook active to close it
'Set newWbk = ActiveWorkbook
newWbk.Close SaveChanges:=False
'Go to working worksheet and force it to recalculate
Sheets("Pricing Worksheet").Select
Worksheets("Pricing Worksheet").Calculate
Range("B1").Select
Application.ScreenUpdating = True
Application.StatusBar = "Done!"
Application.Wait Now + TimeValue("00:00:01")
Application.StatusBar = False
Call xlFileReducer
ActiveWorkbook.Save
End If
End Sub
I am trying to help a buddy via email, with Ron's help we fixed the
Workbooks.OpenText problem, but now we have an error at the
Selection.Sort Key1:=Range("A2") point. It has something to do with him
having Excel 2000 and me Excel 2003.
My tired eyes must be missing something that is different from 2000
to 2003, but I can't find it. I would appreciate the help.
Thanks
Harry
Sub ImportText()
Dim ImportWbk As Workbook
Dim newWbk As Workbook
'Using workbooks.opentext will import the file to a new workbook, so we
'process the imported data then copy it to desired workbook and sheet.
If InputBox("Please enter the password", "Password Needed") <> "*******"
Then
MsgBox ("Wrong Password!")
On Error GoTo 0
Exit Sub
Else
Set ImportWbk = ThisWorkbook
Application.ScreenUpdating = False
Sheets("Data").Select
Application.DisplayStatusBar = True
' makes sure that the statusbar is visible
Application.StatusBar = "Please wait while importing and cleaning
up data..."
' Adjusted Array(53,1) to (54,1)
myFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
'Origin:=437 changed to xlWindows fixed one problem for excel 2000
Workbooks.OpenText Filename:=myFile, _
Origin:=xlWindows, StartRow _
:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(5, 1), Array( _
12, 1), Array(44, 1), Array(47, 1), Array(54, 1), Array(64, 1),
Array(73, 1), Array(82, 1), _
Array(92, 1), Array(102, 1), Array(115, 1), Array(120, 1),
Array(130, 1))
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set newWbk = ActiveWorkbook
Cells.Select
Selection.Columns.AutoFit
'Insert Code to find and delete by product
Call DelByProd
'Insert Code to find and delete next area
Cells.Find(What:="CODE", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:= _
xlNext, MatchCase:=False).Activate ', SearchFormat:=False
Cells(ActiveCell.Row, 1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Code to select area for copy
Range("N5000").Select
Range(Selection, Cells(1)).Select
Selection.Copy
'Change for active worksheet
ActiveSheet.Paste Destination:=ImportWbk.Sheets("Data").Range("A1")
Application.CutCopyMode = False
'Set New workbook active to close it
'Set newWbk = ActiveWorkbook
newWbk.Close SaveChanges:=False
'Go to working worksheet and force it to recalculate
Sheets("Pricing Worksheet").Select
Worksheets("Pricing Worksheet").Calculate
Range("B1").Select
Application.ScreenUpdating = True
Application.StatusBar = "Done!"
Application.Wait Now + TimeValue("00:00:01")
Application.StatusBar = False
Call xlFileReducer
ActiveWorkbook.Save
End If
End Sub