VBA code to move row from one sheet to another and vice versa

[Vsat]

Dear All, I am facing a challenge in writing a VBA Code, Can you please help. My Scenario is I have an Excel file with 2 sheet (ORIGINAL & COMPLETED) and i have a column called status in a drop down box. If i change the status to Completed, Status changed row should be moved to COMPLETED Sheet and if i change the Status again in COMPLETED sheet to Reopened, it should copy and go back to ORIGINAL sheet. I am able to move from ORIGINAL to COMPLETED. But i am unable to move from COMPLETED TO ORIGINAL based on the status change in COMPLETED Sheet.

My Code given below for reference

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsUse As Worksheet
Dim wsDc As Worksheet
Dim wsUse1 As Worksheet
Dim wsDc1 As Worksheet

Dim strdc As String
Dim strdc1 As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Cells.Count > 1 Then Exit Sub

If Target.Column <> 5 Then Exit Sub ' change 2 to the correct column number

Set wsUse = ThisWorkbook.Sheets("ORIGINAL")
Set wsDc = ThisWorkbook.Sheets("COMPLETED")

With wsUse
strdc = Target.Value

If strdc = "Completed" Then

n = .Rows.Count
Target.Offset(0, 5).Value = Format(Now, "DD-MM-YYYY HH:mm")
Target.EntireRow.Copy
wsDc.Range("A" & n).End(xlUp).Offset(1, 0).PasteSpecial xlValues
wsDc.Range("A" & n).End(xlUp).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Target.EntireRow.Delete
End If

End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Joe4]

I am able to move from ORIGINAL to COMPLETED. But i am unable to move from COMPLETED TO ORIGINAL based on the status change in COMPLETED Sheet.

The "Worksheet_Change" event procedure code only applies to the sheet module that the code is placed in. So I am guessing that you currently have this code in the "ORIGINAL" sheet module.
If you want code that runs off of changes in the "COMPLETED" sheet, you will need to create another similar "Worksheet_Change" event procedure in the "COMPLETED" sheet module.

 

[Vsat]

@Joe4 Thanks for your reply, Already tried that, but it is not working. It shows error.

 

[Joe4]

What is the error that it shows?
Can you post the code you have in the other module, and let us know which line it says is causing the error?

Note that if you have code in each module that is moving data to the other sheet, you will probably need to temporarilyy disable events when moving the data to the other sheet so that move doesn't trigger the other code to run at the same time.

You do that like this:
Application.EnableEvents = False
but then you need to turn it on again after your data move with a line like this:
Application.EnableEvents = True
otherwise those event procedure triggers won't work automatically anymore.

 

[Vsat]

I copied the same code and which is written in Original Sheet and changed the source and destination sheet as required. but it shows the error in the attached line below

"wsDc.Range("A" & n).End(xlUp).EntireRow.PasteSpecial xlPasteFormats".

Pastespecial method of range failed error, if i didnt write any vba code in another sheet then this error is not coming.

My Code for Completed sheet given below as required

Private Sub Worksheet_Change(ByVal Target1 As Range)
Dim wsUse1 As Worksheet
Dim wsDc1 As Worksheet
Dim strdc1 As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target1.Cells.Count > 1 Then Exit Sub

If Target1.Column <> 5 Then Exit Sub ' change 2 to the correct column number

Set wsUse1 = ThisWorkbook.Sheets("COMPLETED")
Set wsDc1 = ThisWorkbook.Sheets("ORIGINAL")


With wsUse
strdc1 = Target.Value

If strdc = "Completed" Then

n = .Rows.Count
Target1.Offset(0, 5).Value = Format(Now, "DD-MM-YYYY HH:mm")
Target1.EntireRow.Copy
wsDc.Range("A" & n).End(xlUp).Offset(1, 0).PasteSpecial xlValues
wsDc.Range("A" & n).End(xlUp).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False

End If


End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

What is the error that it shows?
Can you post the code you have in the other module, and let us know which line it says is causing the error?

Note that if you have code in each module that is moving data to the other sheet, you will probably need to temporarilyy disable events when moving the data to the other sheet so that move doesn't trigger the other code to run at the same time.

You do that like this:
Application.EnableEvents = False
but then you need to turn it on again after your data move with a line like this:
Application.EnableEvents = True
otherwise those event procedure triggers won't work automatically anymore.

 

[Joe4]

Why did you change "Target" to "Target1" in the first line of your code, i.e.
Private Sub Worksheet_Change(ByVal Target1 As Range)

You should NEVER change anything in the title row of Event Procedure code. It needs to be a certain way in order for it to run automatically.

You are also getting errors because you have discrepancies in your variable names.
You declared and set "wsDc1" in your code, but then are trying to call "wsDc", which is nothing in this code.

I highly recommend using the "Option Explicit" functionality in your code. This will alert you to these kind of errors in your code when compiling.
See: Option Explicit in Excel VBA

 

[Vsat]

Why did you change "Target" to "Target1" in the first line of your code, i.e.
Private Sub Worksheet_Change(ByVal Target1 As Range)

You should NEVER change anything in the title row of Event Procedure code. It needs to be a certain way in order for it to run automatically.

You are also getting errors because you have discrepancies in your variable names.
You declared and set "wsDc1" in your code, but then are trying to call "wsDc", which is nothing in this code.

I highly recommend using the "Option Explicit" functionality in your code. This will alert you to these kind of errors in your code when compiling.
See: Option Explicit in Excel VBA

Hi, I have modified the code and i am attaching the excel sheet link for your review.
STATUS.xlsm

 

[Joe4]

I cannot download file from my current location (workplace security blocks Google Drive accounts). I should be able to do it later on tonight, when I am at my home computer.

If you are still getting errors, you can also try just pasting the new code here again, and letting me know what the error message says and which line of code is causing your error.

 

[Vsat]

I cannot download file from my current location (workplace security blocks Google Drive accounts). I should be able to do it later on tonight, when I am at my home computer.

If you are still getting errors, you can also try just pasting the new code here again, and letting me know what the error message says and which line of code is causing your error.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsUse1 As Worksheet
Dim wsDc1 As Worksheet
Dim strdc1 As String
Dim k As String


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Cells.Count > 1 Then Exit Sub

If Target.Column <> 5 Then Exit Sub ' change 2 to the correct column number

Set wsUse1 = ThisWorkbook.Sheets("COMPLETED")
Set wsDc1 = ThisWorkbook.Sheets("ORIGINAL")


With wsUse1
strdc1 = Target.Value

If strdc1 = "Reopened" Then

k = .Rows.Count
Target.Offset(0, 6).Value = Format(Now, "DD-MM-YYYY HH:mm")
Target.EntireRow.Copy
wsDc1.Range("A" & k).End(xlUp).Offset(1, 0).PasteSpecial xlValues
wsDc1.Range("A" & k).End(xlUp).EntireRow.PasteSpecial xlPasteFormats - Getting error here (Paste special method of range class failed)
Application.CutCopyMode = False

End If


End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Joe4]

OK, I think I will need to see the data so I can step through it and see what it is doing.
I will try to do that later tonight when I am on my home computer.