VBA Issue with run time error 1004

J

JoeGKushner

New Member
Joined
Feb 22, 2006
Messages
11
Daily I download a file that needs to be modified for review. When I inherited this, there was already a macro created that does this. The problem is because there are thousands of records, it takes a long time to go through it's loop. I've played with making a change in the macro that would just go to the bottom of that row and apply the same formatting and conditioning, which works, but then it crashes when it tries to move on from that providing the error, "run time error 1004. to prevent possible loss of data, Excel cannot shift nonblank cells off of the worksheet. If you do not have data in cells that can be shifted off of the worksheet, you can reset which cells Excel considers nonblank. To do this, press CTRL+End to locate the last nonblank cell of the" and ends. Any help on what's going on? The first set of code is the original. The second my attempt to make it faster. the first works every time and has for years but is sloooow...

Code: 
Public Sub OpenOrder()
Dim I As Long
Dim L As Long
Dim LastRow As Double
Dim LstRow As Integer
Dim LastCol As Integer
Dim strCurCont As String

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(40, 1), Array(45, 1), Array(55, 1), _
        Array(67, 1), Array(75, 1), Array(87, 1), Array(96, 1), Array(107, 1), Array(119, 1)), _
        TrailingMinusNumbers:=True

ActiveCell.SpecialCells(xlLastCell).Select
LastRow = ActiveCell.Row
Range("B1").Select
ActiveCell.EntireColumn.Insert

For I = I To LastRow
    ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])"
    ActiveCell.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
Next I

Range("A1").Select
ActiveCell.EntireColumn.Delete


For I = 1 To LastRow

If IsError(ActiveCell.Value) Then
    strCurCont = ""
Else
    strCurCont = Left(ActiveCell.Value, 4)
End If

Select Case strCurCont

Case ""
ActiveCell.EntireRow.Delete
'
Case "FEDE"
ActiveCell.EntireRow.Delete

Case "Plan"
ActiveCell.EntireRow.Delete

Case "PLAN"
ActiveCell.EntireRow.Delete

Case "----"
ActiveCell.EntireRow.Delete

Case "Sche"
ActiveCell.EntireRow.Delete

Case "Cuto"
ActiveCell.EntireRow.Delete

Case "Item"
ActiveCell.EntireRow.Delete

Case "FED"
ActiveCell.EntireRow.Delete

Case "    "
ActiveCell.EntireRow.Delete

Case "  Cu"
ActiveCell.EntireRow.Delete

Case " FED"
ActiveCell.EntireRow.Delete

Case Else
ActiveCell.Offset(1, 0).Select

End Select

Next I



Range("A1").Select
ActiveCell.EntireRow.Insert
ActiveCell.FormulaR1C1 = "Item#"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Item Description"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "UOM"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Planner"
ActiveCell.Offset(0, 1).Select
ActiveCell.EntireColumn.Delete
ActiveCell.FormulaR1C1 = "Compress Days"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Order Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Dock Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Due Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Quantity"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Value"
Columns("A:J").Select
Columns("A:J").EntireColumn.AutoFit
Columns("H:H").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
ActiveCell.SpecialCells(xlLastCell).Select
LastRow = ActiveCell.Row
Range("B1").Select
Range("A1:J" & LastRow).Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:= _
        Range("J2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
Range("A1").Select
End Sub


That was the original.

Public Sub NewOpenOrder()
Dim I As Long
Dim L As Long
Dim LastRow As Double
Dim LstRow As Integer
Dim LastCol As Integer
Dim strCurCont As String

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(40, 1), Array(45, 1), Array(55, 1), _
        Array(67, 1), Array(75, 1), Array(87, 1), Array(96, 1), Array(107, 1), Array(119, 1)), _
        TrailingMinusNumbers:=True
Range("B1").Select
ActiveCell.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])"
Application.CutCopyMode = False
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A1").Select
ActiveCell.EntireColumn.Delete

For I = 1 To LastRow

If IsError(ActiveCell.Value) Then
    strCurCont = ""
Else
    strCurCont = Left(ActiveCell.Value, 4)
End If

Select Case strCurCont

Case ""
ActiveCell.EntireRow.Delete
'
Case "FEDE"
ActiveCell.EntireRow.Delete

Case "Plan"
ActiveCell.EntireRow.Delete

Case "PLAN"
ActiveCell.EntireRow.Delete

Case "----"
ActiveCell.EntireRow.Delete

Case "Sche"
ActiveCell.EntireRow.Delete

Case "Cuto"
ActiveCell.EntireRow.Delete

Case "Item"
ActiveCell.EntireRow.Delete

Case "FED"
ActiveCell.EntireRow.Delete

Case "    "
ActiveCell.EntireRow.Delete

Case "  Cu"
ActiveCell.EntireRow.Delete

Case " FED"
ActiveCell.EntireRow.Delete

Case Else
ActiveCell.Offset(1, 0).Select

End Select

Next I



Range("A1").Select
ActiveCell.EntireRow.Insert
ActiveCell.FormulaR1C1 = "Item#"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Item Description"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "UOM"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Planner"
ActiveCell.Offset(0, 1).Select
ActiveCell.EntireColumn.Delete
ActiveCell.FormulaR1C1 = "Compress Days"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Order Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Dock Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Due Date"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Quantity"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Value"
Columns("A:J").Select
Columns("A:J").EntireColumn.AutoFit
Columns("H:H").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
ActiveCell.SpecialCells(xlLastCell).Select
LastRow = ActiveCell.Row
Range("B1").Select
Range("A1:J" & LastRow).Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:= _
        Range("J2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
Range("A1").Select
End Sub
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
"run time error 1004. to prevent possible loss of data, Excel cannot shift nonblank cells off of the worksheet. If you do not have data in cells that can be shifted off of the worksheet, you can reset which cells Excel considers nonblank. To do this, press CTRL+End to locate the last nonblank cell of the"
Click to expand...
Sounds like you are trying to insert rows or columns into your worksheet that would push your data past the maximum rows/columns allowed in Excel.
I would recommend minimizing your code to about 1/4 the size of the screen and step through it line-by-line using the F8, so you can watch and see what is happening on the worksheet.
You should be able to see exactly what is happening and when things go haywire. Once you have identified the problem and when it occurs, you can work on rectifying it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
RUN TIME ERROR "1004"
Replies
6
Views
81
Alex Blakenburg
A
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
550
dinunan
D
M
  • Question Question
Not running code
Replies
0
Views
190
MagicCarpet
M
G
  • Question Question
How can i extract the correct leave time on this code?
Replies
1
Views
543
rlv01
R

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

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