Excel move data between sheets automatically

[ExcellNewbie98]

Hi all,

Complete Excel and VBA newbie here I'm afraid.

I'm trying to AUTOMATICALLY move a row of data from one sheet titled "FUTURE JOBS" to another sheet titled "COMPLETED JOBS or CURRENT JOBS". I have a table of data that is constantly expanding or shrinking in the FUTURE JOBS, COMPLETED JOBS and CURRENT JOBS sheet that goes from columns A-J and starts with headers in row 1 (so first row of actual data is in row 3). I need the data to start copying into EMPTY rows on the "COMPLETED JOBS, FUTURE JOBS or CURRENT JOBS" sheet starting in row 3, column A on all of them. I need this to run automatically every time the information in columns A-J (in any cell) is updated. And I need it to only move when the cells in column I of the "FUTURE JOBS" sheet read "Completed jobs, future jobs or current jobs". I need to be able to have three selections per cell 'FUTURE JOBS', 'CURRENT JOBS', 'COMPLETED JOBS' to enable this.

I want to be able to shift jobs between the three sheets as they change progress.

I have attached a photo below for reference. Please let me know if you have any questions and I will respond promptly.

Thank you so much for your help in advance!! It really is greatly appreciated!

Kind regards,

 

[SQUIDD]

IM GUESSING ITS THE WORDING

Try the below, however, i like MY ANSWER IS THIS approach, however, this does not delete the original copy, a simple tweak would fix that.
Although they bot achieve the same thing i would guess MY ANSWER IS THIS code will run quicker.

Sub SORT_MY_JOBS()
    'COMPLETED
    LR_COMPLETED = Range("'COMPLETED JOBS'!A" & Rows.Count).End(xlUp).Row
    For A = LR_COMPLETED To 3 Step -1
        If Range("'COMPLETED JOBS'!I" & A) = "CURRENT" Then
            Range("'COMPLETED JOBS'!A" & A).EntireRow.Copy
            LR_CURRENT = Range("'CURRENT JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_CURRENT = 2 Then LR_CURRENT = 3
            Range("'CURRENT JOBS'!A" & LR_CURRENT).PasteSpecial
            Range("'COMPLETED JOBS'!J" & A).EntireRow.Delete
        End If
        If Range("'COMPLETED JOBS'!I" & A) = "FUTURE" Then
            Range("'COMPLETED JOBS'!A" & A).EntireRow.Copy
            LR_FUTURE = Range("'FUTURE JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_FUTURE = 2 Then LR_FUTURE = 3
            Range("'FUTURE JOBS'!A" & LR_FUTURE).PasteSpecial
            Range("'COMPLETED JOBS'!J" & A).EntireRow.Delete
        End If
    Next A
    'CURRENT
    LR_CURRENT = Range("'CURRENT JOBS'!A" & Rows.Count).End(xlUp).Row
    If LR_CURRENT = 2 Then LR_CURRENT = 3
    For B = LR_CURRENT To 3 Step -1
        If Range("'CURRENT JOBS'!I" & B) = "COMPLETED" Then
            Range("'CURRENT JOBS'!A" & B).EntireRow.Copy
            LR_COMPLETED = Range("'COMPLETED JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_COMPLETED = 2 Then LR_COMPLETED = 3
            Range("'COMPLETED JOBS'!A" & LR_COMPLETED).PasteSpecial
            Range("'CURRENT JOBS'!J" & B).EntireRow.Delete
        End If
        If Range("'CURRENT JOBS'!I" & B) = "FUTURE" Then
            Range("'CURRENT JOBS'!A" & B).EntireRow.Copy
            LR_FUTURE = Range("'FUTURE JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_FUTURE = 2 Then LR_FUTURE = 3
            Range("'FUTURE JOBS'!A" & LR_FUTURE).PasteSpecial
            Range("'CURRENT JOBS'!J" & B).EntireRow.Delete
        End If
    Next B
    'FUTURE
    LR_FUTURE = Range("'FUTURE JOBS'!A" & Rows.Count).End(xlUp).Row
    If LR_FUTURE = 2 Then LR_FUTURE = 3
    For C = LR_FUTURE To 3 Step -1
        If Range("'FUTURE JOBS'!I" & C) = "CURRENT" Then
            Range("'FUTURE JOBS'!A" & C).EntireRow.Copy
            LR_CURRENT = Range("'CURRENT JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_CURRENT = 2 Then LR_CURRENT = 3
            Range("'CURRENT JOBS'!A" & LR_CURRENT).PasteSpecial
            Range("'FUTURE JOBS'!J" & C).EntireRow.Delete
        End If
        If Range("'FUTURE JOBS'!I" & C) = "COMPLETED" Then
            Range("'FUTURE JOBS'!A" & C).EntireRow.Copy
            LR_COMPLETED = Range("'COMPLETED JOBS'!A" & Rows.Count).End(xlUp).Row + 1
            If LR_COMPLETED = 2 Then LR_COMPLETED = 3
            Range("'COMPLETED JOBS'!A" & LR_COMPLETED).PasteSpecial
            Range("'FUTURE JOBS'!J" & C).EntireRow.Delete
        End If
    Next C
End Sub

 

[ExcellNewbie98]

I've just tried this and this isn't working - is it something I've done wrong?

 

[SQUIDD]

I've just tried this and this isn't working - is it something I've done wrong?

Right click on the sheet tab and click view code, then paste this into the sheet module.

 

[SQUIDD]

Hi,

I attached a photo, it's not working. I'm assuming I've done something wrong -

again the samller code needs to go into the sheet module of all 3 sheets.

right click eack of the 3 sheet tabs, click view code and put the smaller code in there.

the larger code is correct in a standard module

 

[My Aswer Is This]

I've just tried this and this isn't working - is it something I've done wrong?

This script does not go in a module. I explained here how to install script:

I've just tried this and this isn't working - is it something I've done wrong?

This script does not go in a module.
In my post I said this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

The script runs when you enter a sheet name in column 9

 

[My Aswer Is This]

I'm getting confused here. Did you try my script?
And install it the way I mentioned
And I could include one more line of code to delete the row in the original sheet if you wanted.
This code is all that is needed you need no other code.

 

[My Aswer Is This]

If you want the row deleted after the row is copied to other sheet, try this

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  7/8/2022  4:12:32 PM  EDT
If Target.Column = 9 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
On Error GoTo M
Application.ScreenUpdating = False
Dim ans As String
Dim r As Long
Dim Lastrow As Long
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem" & vbNewLine & "You Entered  " & Target.Value & vbNewLine & "We have no sheet by that name"
End Sub

 

[SQUIDD]

if you had an empty sheet your code would start adding data into row 2, OP said row 2 is blank.

suggest adding

If Lastrow = 2 Then Lastrow = 3

maybe?

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  7/8/2022  4:12:32 PM  EDT
If Target.Column = 9 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
On Error GoTo M
Application.ScreenUpdating = False
Dim ans As String
Dim r As Long
Dim Lastrow As Long
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Lastrow = 2 Then Lastrow = 3
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem" & vbNewLine & "You Entered  " & Target.Value & vbNewLine & "We have no sheet by that name"
End Sub

If you want the row deleted after the row is copied to other sheet, try this

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  7/8/2022  4:12:32 PM  EDT
If Target.Column = 9 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
On Error GoTo M
Application.ScreenUpdating = False
Dim ans As String
Dim r As Long
Dim Lastrow As Long
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem" & vbNewLine & "You Entered  " & Target.Value & vbNewLine & "We have no sheet by that name"
End Sub

 

[My Aswer Is This]

OK try this: I missed the part about starting on row 3

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  7/8/2022  4:42:20 PM  EDT
If Target.Column = 9 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
On Error GoTo M
Application.ScreenUpdating = False
Dim ans As String
Dim r As Long
Dim Lastrow As Long
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Lastrow = 2 Then Lastrow = 3
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem" & vbNewLine & "You Entered  " & Target.Value & vbNewLine & "We have no sheet by that name"
End Sub

 

[My Aswer Is This]

if you had an empty sheet your code would start adding data into row 2, OP said row 2 is blank.

suggest adding

If Lastrow = 2 Then Lastrow = 3

maybe?

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  7/8/2022  4:12:32 PM  EDT
If Target.Column = 9 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
On Error GoTo M
Application.ScreenUpdating = False
Dim ans As String
Dim r As Long
Dim Lastrow As Long
r = Target.Row
ans = Target.Value
Lastrow = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Lastrow = 2 Then Lastrow = 3
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
End If
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem" & vbNewLine & "You Entered  " & Target.Value & vbNewLine & "We have no sheet by that name"
End Sub

Thanks for pointing that out I missed that requirement.