Excel VBA - Auto move rows not working correctly

[drewhx15]

Hello,

I am hoping you can help.

The below code works on and off. It is driving me mad as it intermittently stops doing the task. I have two sheets (1 & 2) -

When column M (Sheet1) has one of 4 outcomes added (Drop down list), it then moves it from Sheet1 to Sheet2 automatically, problem is it repeatedly stops working after a few successful moves.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
A = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For I = 2 To A

If Worksheets("Sheet1").Cells(I, 13).Value = "Successful" Or Worksheets("Sheet1").Cells(I, 13).Value = "Un-Successful" Or Worksheets("Sheet1").Cells(I, 13).Value = "N/A" Or Worksheets("Sheet1").Cells(I, 13).Value = "Other" Then
Worksheets("Sheet1").Rows(I).Cut
Worksheets("Sheet2").Activate

B = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(B + 1, 1).Select

ActiveSheet.Paste

Worksheets("Sheet1").Activate

End If

Next

For I = 2 To A

If Worksheets("Sheet1").Cells(1, 1).Value = " " Then
Rows(I).Delete

End If

Next

End Sub

Really hope you legends can help me with thism I have been trying for days but, now realise I need to ask the experts for help

Drew

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Column = 13 Then
      Select Case Target.Value
         Case "Successful", "Un-Successful", "N/A", "Other"
            Target.EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Target.EntireRow.Delete
         Case ""
            Target.EntireRow.Delete
      End Select
   End If
End Sub

 

[drewhx15]

Hi Fluff,

Thanks for your response! The code moves from sheet1 to sheet2 but, it is overwriting the last row it moved instead of continuing down from the next available row? Hope that makes sense?

Kind regards,
Drew

 

[Fluff]

Will column A always have a value, or can it be blank?

 

[drewhx15]

Yes, column A will have a value always. It will be names that populate A.

 

[drewhx15]

Hi, I didn't notice but column A was empty :/ I have populated the sheet and it is moving them correctly - Thank you so much for your quick and AWESOME support. I love this forum! Thanks again <3

 

[Fluff]

In case that ever happens again you can use

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Column = 13 Then
      Select Case Target.Value
         Case "successful", "Un-Successful", "N/A", "Other"
            Target.EntireRow.Copy Sheets("Sheet2").Range("M" & Rows.Count).End(xlUp).Offset(1, -12)
            Target.EntireRow.Delete
         Case ""
            Target.EntireRow.Delete
      End Select
   End If
End Sub

which uses col M to find the last row.

 

[drewhx15]

You are amazing! Thank you Fluff <3 Have a great day!

 

[Fluff]

You're welcome & thanks for the feedback.