After Deleting Rows. next Row does not move up

[Craigos]

Hi,

I have a macro that exports a row (or rows) to destination sheet ("Amber") based on criteria in Column K. Once exported I return to the source sheet ("Register") and the row that had the data that I wanted exported has exported the info but the row just sits where it was and appears to only 'clear the contents'. The macro I use is:

Sub Extract_FW_Rows()
Set ws = ActiveSheet
endrow = ws.Cells(65000, 1).End(xlUp).Row
For i = endrow To 1 Step -1
If ws.Cells(i, 9).Value = "Found Work" Then
exportrow = Sheets("Amber").Cells(65000, 1).End(xlUp).Row + 1
Sheets("Amber").Rows(exportrow).Value = ws.Rows(i).Value
ws.Rows(i).Delete
End If
Next
Worksheets("Register").Select
Worksheets("Register").Activate
Range("A3").Select
End Sub

I set up the macro on Excel 2002 in work as thats what we have....however when I input the same code into my home laptop working Excel 2007, all works perfectly i.e. it cuts the data to destination sheet, goes back to source sheet and the rows have moved up accordingly - I do realise that the action taken is a row removal i.e. I had 1000 rows, macro executes, I now have 999 rows in the source sheet.

What I would like is the same result in 2002 as I get in 2007.

Can anyone help?

Craigos

 

[Akinrotimi]

Craigos,

The code below would promptly solve the problem:

Option Explicit
Sub Rows Copy and Delete()
' akinrotimi, 13/08/2011
http://www.mrexcel.com/forum/newreply.php?do=newreply&noquote=1&p=2826826
Application.ScreenUpdating = False
    Sheets("register").Select
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-16]=""found work"","""",RC[-16])"
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-16]=""found work"","" "",RC[-16])"
    Range("AA1").Select
    Selection.AutoFill Destination:=Range("AA1:AA3000"), Type:=xlFillDefault
    Range("AA1:AA3000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("AA:AA").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlFixedWidth, _
        OtherChar:="[", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
    Range("I2").Select
    Sheets("amber").Select
    Range("a1").Select
    Sheets("register").Select
    Columns("aa:aa").SpecialCells(xlCellTypeBlanks).EntireRow.Copy
    Sheets("amber").Select
    ActiveSheet.Paste
    Range("a1").Select
    Sheets("register").Select
    Columns("aa:aa").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns("aa:aa").Select
    Selection.ClearContents
    Range("k1").Select
    Application.ScreenUpdating = True
    end sub

Regards

Rotimi

 

[Craigos]

Hi Rotimi,

Thanks for the code, been trying it out and have a couple of problems.....

1st - My sheets have headers and the actual data rows start at row 3 - So I do get an error as 'Error Time 1004....Destination reference is not valid'

2nd - The 'Found Work' criteria can be on any number of rows on the source sheet...when I tried the code out (without headers) it overwrote the destination sheet, I need the rows to be pasted into next empty row - similar to my posted code - so I can just keep updating the destination sheet as time goes on.

Any Ideas?

Craigos

 

[Akinrotimi]

OK.

I have updated the code as stated below:

Option Explicit
Sub Rows Copy and Delete()
' akinrotimi, 13/08/2011
http://www.mrexcel.com/forum/newrepl...te=1&p=2826826
Application.ScreenUpdating = False
    Sheets("register").Select
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-16]=""found work"","""",RC[-16])"
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-16]=""found work"","" "",RC[-16])"
    Range("AA1").Select
    Selection.AutoFill Destination:=Range("AA1:AA3000"), Type:=xlFillDefault
    Range("AA1:AA3000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("AA:AA").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlFixedWidth, _
        OtherChar:="[", FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
    Range("I1000000").Select
    Range("aa1").Select
    ActiveCell.FormulaR1C1 = "header"
    Range("aa2").Select
    ActiveCell.FormulaR1C1 = "header"
    Sheets("amber").Select
    Range("a1").Select
    Sheets("register").Select
    Columns("aa:aa").SpecialCells(xlCellTypeBlanks).EntireRow.Copy
    Sheets("amber").Select
    Range("a1000000").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("a1").Select
    Sheets("register").Select
    Columns("aa:aa").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns("z:aa").Select
    Selection.ClearContents
    Range("a1").Select
    Application.ScreenUpdating = True
    end sub

Give me an update please after retesting.

Regards

Rotimi

 

[MARK858]

Craigos, sorry to ask this, but if everything else is running correctly have you tried changing

ws.Rows(i).Delete

to

ws.Rows(i).Delete Shift:=xlUp

to see what happens?
Can't test myself as like you I am currently on 2007 and so your code appears to run correctly

 

[MARK858]

Or even

ws.Rows(i).EntireRow.delete

Afraid I am not familiar with 2002 but they are worth a go. I must admit I am a bit confused as I thought the shift rows up after an entire row delete was a default setting in all versions

 

[Craigos]

My apologies for not answering earlier...suffice to say I have been unwell.....

I ended up reconstructing my workbook from scratch and the error was caused by a Worksheet Change event. This error was not coming up as an error until I did each step seperately with the workbook and actually had nothing to do with the original code.

Mark, you were dead right about the default settings for delete row and shifting up, as I say it was the error that caused the problem.

Akinrotimi, the example you gave me errored out at the range select (1Mill) point and as I had now redone my workbook, there was no need to figure out why yours errored there - hope you understand.

Sorry for any inconvenience, I don't want to upset anyone with my untimely tardiness (circumstances beyond control and all that) as this forum provides me with vast knowledge to keep the Boss off my back.

Many Many Thanks for replying to my post

Regards

Craigos