View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Edgar Thoemmes[_4_] Edgar Thoemmes[_4_] is offline
external usenet poster
 
Posts: 16
Default Macro causes Excel to crash

HI

I am using the macro below to auto format some data I have in multiple
sheets, I cycle through the sheets in another macro and then call the below
macro when the sheet is activated.

This works fine but it crashed after processing about 16-18 sheets out of
30-40. It stops on a sheet and then comes up with the error 'Not enough
Memory' The sheet that it stops on is exactly the same format as the others.
Can anyone spot anything that I have done which may have caused this? I was
under the impression that it would just work its way through the sheets and
if it was low on memory would just slow down?

I am using Access 97 on a P3 128mb ram running Windows NT.

Thanks

Sub ManipulateData()

'Delete out "/" from CC ref
Columns("B:B").Replace What:="/", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

'Delete out redundant Row
Rows("2:2").Delete Shift:=xlUp

'Sort Values based on Seq Number
Range("B2:J929").Sort Key1:=Range("B3"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Delete out empty column
Range("A2:A65536").Delete Shift:=xlToLeft

'Copies Column headings across to accomodate extra supplier id column
Range("G2:K2").Cut Destination:=Range("H2")

'Add formulas to extra columns and autofill down
lrow = Range("A65536").End(xlUp).Row

Range("J3").Formula = "=IF(A3="""","""",$A$1)"
Range("J3").AutoFill Destination:=Range("J3:J" & lrow)

Range("K3").Formula = "=IF(A3="""","""",$A$1)"
Range("K3").AutoFill Destination:=Range("K3:K" & lrow)

'Delete out Redundant Text Rows
For t = 3 To 100
txtchck = IsNumeric(Range("A" & t).Value)
If txtchck = False Then
Rows(t & ":1000").Delete
Else
End If
Next t

'Copy and Paste Special -- Values Formula's
Range("J1:K" & lrow).Copy
Range("J1:K" & lrow).PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False

'Delete out Redundant top rows
Rows("1:2").Delete Shift:=xlUp

End Sub