Solved: Cut entire rows to sheet on condition

[Marcster]

Hi People,

Is the following possible?:

Cut entire row of rows that have 'DELETE' in col A on sheet MAIN.
Ensuring the values (Col D) nett off to zero.
Display message of the value and do not allow delete if not zero.
Then paste on new line at the end of the list on 'DELETED' sheet.
When pasted into sheet DELETED, give the cut rows the same unique ref of DEL1, DEL2, DEL3 etc in Col A for each time the Macro is run.

Example workbook attached.

Thanks

[georgiboy]

Something like this maybe...

[Bob Phillips]

[vba]

Public Sub DeleteRowsUsingAutofilter()
Const TestColumn As Long = 1
Dim wsDeleted As Worksheet
Dim NextRow As Long
Dim NextID As Long
Dim cRows As Long
Dim rng As Range

Set wsDeleted = Worksheets("DELETED")
NextRow = wsDeleted.Cells(wsDeleted.Rows.Count, "A").End(xlUp).Row + 1

With ActiveSheet

'first, count the rows to operate on
cRows = .Cells(.Rows.Count, "C").End(xlUp).Row

'now add a header row for autofilter
.Rows(1).Insert
.Cells(1, TestColumn).Value = "Filter"

'finally, apply the autofilter for al matching cells
With Intersect(.UsedRange, .Columns(TestColumn))

.AutoFilter
.AutoFilter Field:=1, Criteria1:="DELETE"
End With

If Application.Sum(Intersect(.UsedRange, .Columns("C"))) <> 0 Then

MsgBox "Rows do not nett off to zero!)"
Else

On Error Resume Next
Set rng = Intersect(.UsedRange, .Columns(TestColumn)).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng Is Nothing Then

rng.EntireRow.Copy wsDeleted.Cells(NextRow, "A")
NextID = Application.Evaluate("MAX(IF(LEFT(DELETED!A1:A" & NextRow - 1 & ",3)=""DEL"",--MID(DELETED!A1:A" & NextRow - 1 & ",4,99)))")
wsDeleted.Range(wsDeleted.Cells(NextRow, "A"), wsDeleted.Cells(NextRow, "A").End(xlDown)).Value = "DEL" & NextID + 1
wsDeleted.Rows(NextRow).Delete
rng.EntireRow.Delete
End If

.Rows(1).Delete
End If
End With

End Sub
[/vba]

[mdmackillop]

[VBA]
Option Explicit
Sub DelRows()
Dim Chk As Single
Dim Rng As Range
Dim Tgt As Range
Dim i As Long
Dim Cnt As Long
On Error Resume Next
Cnt = Split(ActiveWorkbook.Names("Cnt"), "=")(1)
If Cnt = 0 Then
ActiveWorkbook.Names.Add Name:="Cnt", RefersTo:=0
End If
On Error GoTo 0
Set Rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
Chk = Application.SumIf(Rng, "DELETE", Rng.Offset(, 3))
If Abs(Chk) < 0.001 Then
Cnt = Cnt + 1
For i = Rng.Cells.Count To 1 Step -1
If Rng(i) = "DELETE" Then

ActiveWorkbook.Names.Add Name:="Cnt", RefersTo:=Cnt
Set Tgt = Sheets("DELETED").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Tgt = "DEL" & Cnt
Rng(i).Offset(, 2).Resize(, 2).Cut Tgt.Offset(, 1)
Rng(i).EntireRow.Delete
End If
Next
Else
MsgBox "Nett = " & Chk
End If
End Sub

[/VBA]

[Marcster]

Excellant Guys . Thanks Alot.

Just what I was after.

[Marcster]

Hi Guys,

How do I change mdmackillop's code above to paste the entire row's contents from MAIN to DELETED?.
As currently this does not.
By inserting additional texts in col E:AD in MAIN and running macro,
all ok with MAIN, but on DELETED, the entire row is not pasted over from MAIN.

Thanks.

[mdmackillop]

[VBA]Rng(i).Offset(, 2).Resize(, 250).Cut Tgt.Offset(, 1) [/VBA]