[BremNerd]

I am working in Excel 2003, within XP and have the following situation.

For approximately 18 months, I have been running the macro listed below without issue. Now, for no apparent reason, the macro fails to execute in its entirety. When executing the macro from within Excel, the execution starts and proceeds a few lines and then just stops. No error, no warning, nothing, the macro just stops.

If I open up the Visual Basic editor screen from within Excel and attempt to execute the macro with F5 or step through line by line with F8, execution will proceed to the end of the Selection.TextToColumns command line, and the insertion point goes back to the start of this same command once executed. If F8 is pressed a second time, the insertion point goes all the way back to the Sub line at line 1 of the macro and tries to run the macro again. The behaviour is consistent, and no error code or indication occurs. The code has not changed.

If I break up the macro into a series of smaller macros at each error point, and run them sequentially, I get the desired outcome.

I have tried renaming, copying and pasting the text into different macro files, exporting the macro and re-importing into different worksheets (this one is currently sitting in personal.xls which is still sitting in my /xlstart subfolder.

I have 8 similar macros that now all do the same thing - very puzzling.

Would welcome any suggestions you may have. Thanks all.

ps. for all you real VBA folks out there, no this isn't pretty, but it works.

VBA macro follows
---------------------------------------------------------------------
Sub MacPac_UsageImportForPC99()
'
' MacPac_UsageImportStep1 Macro
' Macro recorded 6/14/2005 by Tim Bremner
' Raw materials at HCA
'
Dim myRange As Range
Dim TestRow As Integer
Dim EndTrigger As Integer
Dim RowCounter As Integer
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(22, 1), Array(47, 1), Array(49, 1), _
Array(51, 1), Array(62, 1), Array(65, 1), Array(68, 1), Array(70, 1), Array(75, 1), Array( _
80, 1), Array(90, 1), Array(102, 1), Array(115, 1), Array(126, 1), Array(138, 1), Array(140 _
, 1), Array(145, 1), Array(153, 1), Array(160, 1), Array(171, 1), Array(181, 1), Array(193, _
1)), TrailingMinusNumbers:=True
'EXECUTES TO HERE, STOPS, AND PLACES THE INSERTION POINT BACK ON THE SAME EXECUTION LINE
'PRESSING F8 AGAIN FOR THE NEXT LINE PLACES THE INSERTION POINT BACK ON LINE 1 OF THE MACRO AND STARTS AGAIN

Rows("1:3").Delete
Rows("1:3").Select
Selection.Insert Shift:=xlDown
ActiveWindow.Zoom = 80
'Make a copy of the original sheet and label it so.
Worksheets(1).Select
Worksheets(1).Name = "Original"
Sheets("Original").Copy After:=Sheets(1)
Worksheets(2).Select
Worksheets(2).Name = "Working"

Range("B1").Value = "PN"
Range("C1").Value = "Description"
Range("D1").Value = "PT"
Range("E1").Value = "MB"
Range("F1").Value = "Valve Type"
Range("G1").Value = "PC"
Range("H1").Value = "SC"
Range("I1").Value = "CD"
Range("J1").Value = "QTY"
Range("K1").Value = "INCR"
Range("L1").Value = "Qty on Hand"
Range("M1").Value = "Invoiced YTD"
Range("N1").Value = "Qty Issued to MO's"
Range("O1").Value = "Tot Usage This Year"
Range("P1").Value = "Tot Usage Last Year"
Range("Q1").Value = "LT"
Range("R1").Value = "Lead Time"
Range("S1").Value = "TRN Cum Day LT"
Range("T1").Value = "Safety Stock"
Range("U1").Value = "Std Unit Cost"
Range("A1").Value = "Index"


'Find the approximate end of the range so that we can set an index column.
'Scan down column B until we find 20 consecutive rows that are empty.
EndTrigger = 0
TestRow = 0
Range("B2").Select
Do Until EndTrigger = 100
If ActiveCell.Offset(TestRow, 0).Value <> "" Then
ActiveCell.Offset(TestRow, -1) = TestRow + 1
TestRow = TestRow + 1
Application.StatusBar = "Indexing row number " & TestRow
EndTrigger = 0
Else
ActiveCell.Offset(TestRow, -1) = TestRow + 1
EndTrigger = EndTrigger + 1
TestRow = TestRow + 1
End If
Loop
Application.StatusBar = False


'Now sort and delete the rows that aren't
' 9P = Plastic Pellets
' 9M = Miscellaneous

Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
myRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
EmptyCheck = False
nRows = myRange.Rows.Count
Application.ScreenUpdating = False
myRange.Cells(2, 8).Select
Do While EmptyCheck = False
If ActiveCell.Value = "9M" Or ActiveCell.Value = "9P" Then
ActiveCell.Offset(1, 0).Select
CellValue = ActiveCell.Value
EmptyCheck = IsEmpty(CellValue)
Else
ActiveCell.EntireRow.Delete
CellValue = ActiveCell.Value
EmptyCheck = IsEmpty(CellValue)
End If
Application.StatusBar = "Filtering check on row " & ActiveCell.Row()
Loop

Application.StatusBar = False
ActiveCell.Offset(0, -7).Select
ActiveCell.EntireRow.Insert
ActiveCell.Offset(1, 0).Select
Set myRange = ActiveCell.CurrentRegion
myRange.EntireRow.Delete
Range("A1").Select

'Apply some heading formats, delete useless colums, and adjust column widths
' for readability.
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.SmallScroll toRight:=6
Columns("V:X").Select
Selection.Delete Shift:=xlToLeft
Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("I:K").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("O:O").ColumnWidth = 6
Columns("M:M").ColumnWidth = 10
Columns("L:L").ColumnWidth = 9
Columns("K:K").ColumnWidth = 9
Columns("I:I").ColumnWidth = 8
Columns("J:J").ColumnWidth = 7
Rows("1:1").EntireRow.AutoFit
Columns("Q:Q").Select
Selection.Style = "Currency"
Range("A1").Select

'Now make a copy of the Working Sheet and do
'Raw, Mix, Cold Bushing and Hot Bushing Sheets

Worksheets(2).Select
Sheets(2).Copy After:=Sheets(2)
Sheets(2).Copy After:=Sheets(3)
Worksheets(3).Name = "SC=9P Pellets"
Worksheets(4).Name = "SC=9M Misc"

Worksheets(2).Select
Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
ActiveWindow.LargeScroll toRight:=-1
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
myRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


Worksheets(3).Select
Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
nRows = myRange.Rows.Count
Application.ScreenUpdating = False
For nCount = myRange.Rows.Count To 2 Step -1
If myRange.Cells(nCount, 8).Value <> "9P" Then
Application.StatusBar = "Working on row " & nCount & " of " & Worksheets(3).Name
myRange.Rows(nCount).Delete
End If
Next
Application.StatusBar = False
Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
ActiveWindow.LargeScroll toRight:=-1
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
myRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Worksheets(4).Select
Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
nRows = myRange.Rows.Count
Application.ScreenUpdating = False
For nCount = myRange.Rows.Count To 2 Step -1
If myRange.Cells(nCount, 8).Value <> "9M" Then
Application.StatusBar = "Working on row " & nCount & " of " & Worksheets(4).Name
myRange.Rows(nCount).Delete
End If
Next
Application.StatusBar = False
Range("A1").Select
Set myRange = ActiveCell.CurrentRegion
ActiveWindow.LargeScroll toRight:=-1
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
myRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

[computerman29642]

Can you post an Excel workbook that contains the macro?

[BremNerd]

After another day of wrangling with this problem, found the solution.

This macro assumes that the starting file that is opened within Excel is an ASCII file, fixed width columns in its original format. The problem described in my initial post occurs depending upon how that initial file is opened within Excel. The macro expects to recieve the native ASCII file in a single column, with the initial macro command used to parse the file. When opening an ASCII or other file from within Excel and you wish to supress the use of default Data... Text to Columns... settings being applied, you hold down the shift key when opening the file from the File... Open... dialog. If you do this, the macro fails to execute and behaves the same way as described in my initial post. If however you drag and drop the ASCII file onto the Excel window, and clear all delimiters if it automatically enters the Text to Columns Wizard, the macro executes flawlessly.

So, long story short, there was no fault within the macro, but the manner in which the file was opened within Excel appears to impact the successful execution of the macro.

Sounds impossible, but I've tried it on over 14 files on three different computers and the pattern is consistent. Bizarre. I am sure that there is likely a root cause somewhere within the workings of Excel that the experts in this forum can likely sort out, but for me the problem is solved.

Thanks for reading, and offers of assistance. I think this one is cracked, if there are any further questions please post.

BremNerd

[Aj_old]

Hi!
Glad that you find the solution!
Now you can mark the thread as solved!

[Rollin_Again]

So does that mean that the macro will not work or were you able to modify it so that it functions properly?

Regards,
Rollin

[BremNerd]

The macro works without modification. The discovery was that the fault occurred depending on how the original ASCII file was opened. When opening using the File... Open... dialog from within Excel, and holding down the Shift key to suppress the Text to Columns wizard, the macro did not execute properly. When simply dragging and dropping the ASCII file onto the Excel application, you still have to walk through the Text to Columns wizard to suppress all delimiters and have the file open in the raw format the macro expects.

Sure hate the text to columns wizard, or specifically that it pops up when not needed or wanted. Wish I could disable THAT behaviour...

cheers