VBA to transfer a row of data based on 1 cell value

[RangerRuss]

Hi all,

I am trying to write a VBA to copy a row of data off Sheet1 based on the word "Settled" in column D and then insert the data onto Sheet2 (into the exact same columns) and then delete the row of data off Sheet1. I would then like all the remaining rows left on Sheet1 move up and fill the row gaps left by the transferred Settled rows. This will be executed by pressing the button on Sheet1 called "UPDATE".

I would also like to have a message appear once the button above is pressed to warn users that "proceeding will delete information immediately" Yes or No (No will end the sub and yes will execute the sub)

Sorry, I cant download the XL2BB as I am working off a work computer.

Thank you in advance.

 

[rpaulson]

try this on a copy of you file.

Sub Move_Settled()

Dim rs As Worksheet
Set rs = Worksheets("Sheet2")

cnt = 0

x = MsgBox("proceeding will delete information immediately", vbQuestion + vbYesNo + vbDefaultButton2, "Move Settled to sheet 2")
If x <> vbYes Then Exit Sub

For r = 1 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(r, "D") = "Settled" Then

    lr = rs.Cells(Rows.Count, "D").End(xlUp).Row + 1
    Rows(r).EntireRow.Copy rs.Range("A" & lr)
cnt = cnt + 1
End If
Next r

'delete settled

On Error Resume Next
    With Range("D:D")
        .Replace "Settled", False, xlWhole
        .SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
    End With
On Error GoTo 0


MsgBox cnt & "-Record(s) Deleted"

End Sub

hth,

Ross

 

[RangerRuss]

try this on a copy of you file.

Sub Move_Settled()

Dim rs As Worksheet
Set rs = Worksheets("Sheet2")

cnt = 0

x = MsgBox("proceeding will delete information immediately", vbQuestion + vbYesNo + vbDefaultButton2, "Move Settled to sheet 2")
If x <> vbYes Then Exit Sub

For r = 1 To Cells(Rows.Count, "D").End(xlUp).Row
If Cells(r, "D") = "Settled" Then

    lr = rs.Cells(Rows.Count, "D").End(xlUp).Row + 1
    Rows(r).EntireRow.Copy rs.Range("A" & lr)
cnt = cnt + 1
End If
Next r

'delete settled

On Error Resume Next
    With Range("D:D")
        .Replace "Settled", False, xlWhole
        .SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
    End With
On Error GoTo 0


MsgBox cnt & "-Record(s) Deleted"

End Sub

hth,

Ross

Thanks Ross,
This works great but the code deletes all the settled lines from the worksheet but only pastes the first record onto sheet 2.
Any ideas?

Your help is greatly appreciated.