VBA for moving an entire row from one sheet to another and then back again

[bembry369]

Im trying to move entire rows automatically based on criteria from one sheet to another and then back if needed. I found code that lets me move an entire row from one sheet to another sheet, and it works perfectly. However I would like to be able to move it back automatically based on criteria if needed. The sheet is for tool inventory. When a tool comes back from a job I type "yes" in the returned column and that row gets moved to the returned sheet and deleted from the out sheet, but I want to be able to move it back to the out sheet automatically when I send it back out. Below is the code I'm using now .

Module Code is

Sub MoveBasedOnValue()

'Created by Excel 10 Tutorial

Dim xRg As Range

Dim xCell As Range

Dim A As Long

Dim B As Long

Dim C As Long

A = Worksheets("Out").UsedRange.Rows.Count

B = Worksheets("Returned").UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(Worksheets("Returned").UsedRange) = 0 Then B = 0

End If

Set xRg = Worksheets("Out").Range("H1:H" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Value) = "yes" Then

xRg(C).EntireRow.Copy Destination:=Worksheets("Returned").Range("A" & B + 1)

xRg(C).EntireRow.Delete

If CStr(xRg(C).Value) = "yes" Then

C = C - 1

End If

B = B + 1

End If

Next

Application.ScreenUpdating = True

End Sub

Sheet Code is

Private Sub Worksheet_Change(ByVal Target As Range)

'Subscribe to youtube.com/excel10tutorial

Dim Z As Long

Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call MoveBasedOnValue

End If

Next

Application.EnableEvents = True

End Sub

 

[Snakehips]

@bembry369
Entering 'yes' into column H of the Out sheet is your current trigger to make a return from Out to Returned.
One that is pasted to Returned sheet, does that 'yes' remain in the new H ?
What would be your similar trigger to send from the Returned sheet to the Out sheet?
Am I right in thinking that you intentionally have this coded to do more than one return at a time?

 

[bembry369]

@bembry369
Entering 'yes' into column H of the Out sheet is your current trigger to make a return from Out to Returned.
One that is pasted to Returned sheet, does that 'yes' remain in the new H ?
What would be your similar trigger to send from the Returned sheet to the Out sheet?
Am I right in thinking that you intentionally have this coded to do more than one return at a time?

Thanks for your reply, and yes you are correct, more times than not we have multiples tools coming back from a particular job at the same time. The trigger word I'm trying to use to move back to out sheet is "no".
Here is a picture of the header from the "Out" sheet in which column H is labeled "returned?".. This is where the trigger word "yes" is typed.

Job Name

Qty

Tool Number

Item Description

Condition

Date Delivered

Returned?

Foreman

This is a screen shot of the header I'm using on the returned sheet. I changed column H header to "Still at shop" on returned sheet. This is where I would like to the trigger word "no" to be used by simply changing the yes to no I would like that row to go back into the "Out" sheet.

Thanks again for your help

Job Name

Qty

Tool Number

Item Description

Condition

Date Delivered

Still at shop?

Foreman

Return Date

 

[Snakehips]

Give this a try. Test on a backed up file.
Copy following to a Module.

Sub MoveBasedOnValue(YsNo As String)

'Common Sub for a Code Module
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long


Dim ToSheet As Worksheet
Dim FroSheet As Worksheet

Select Case YsNo
 Case "yes"
    Set ToSheet = Sheets("Returned")
    Set FroSheet = Sheets("Out")
Case "no"
    Set ToSheet = Sheets("Out")
    Set FroSheet = Sheets("Returned")
End Select

A = FroSheet.UsedRange.Rows.Count

B = ToSheet.UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(ToSheet.UsedRange) = 0 Then B = 0

End If

Set xRg = FroSheet.Range("H1:H" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Value) = YsNo Then

xRg(C).EntireRow.Copy Destination:=ToSheet.Range("A" & B + 1)

xRg(C).EntireRow.Delete

If CStr(xRg(C).Value) = YsNo Then

C = C - 1

End If

B = B + 1

End If

Next

Application.ScreenUpdating = True

End Sub

Then these to their appropriate sheet code modules.

Private Sub Worksheet_Change(ByVal Target As Range)

'Sub for Returned sheet

Dim ToSht As String
Dim FroSht As String
Dim YsNo As String
Dim Z As Long
Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then
'********************************
YsNo = "no"
'**********************************
Call MoveBasedOnValue(YsNo)

End If

Next

Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'Sub for Returned sheet

Dim ToSht As String
Dim FroSht As String
Dim YsNo As String
Dim Z As Long
Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then
'********************************
YsNo = "yes"
'**********************************
Call MoveBasedOnValue(YsNo)

End If

Next

Application.EnableEvents = True

End Sub

Hope that helps.

 

[bembry369]

Give this a try. Test on a backed up file.
Copy following to a Module.

Sub MoveBasedOnValue(YsNo As String)

'Common Sub for a Code Module
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long


Dim ToSheet As Worksheet
Dim FroSheet As Worksheet

Select Case YsNo
 Case "yes"
    Set ToSheet = Sheets("Returned")
    Set FroSheet = Sheets("Out")
Case "no"
    Set ToSheet = Sheets("Out")
    Set FroSheet = Sheets("Returned")
End Select

A = FroSheet.UsedRange.Rows.Count

B = ToSheet.UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(ToSheet.UsedRange) = 0 Then B = 0

End If

Set xRg = FroSheet.Range("H1:H" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Value) = YsNo Then

xRg(C).EntireRow.Copy Destination:=ToSheet.Range("A" & B + 1)

xRg(C).EntireRow.Delete

If CStr(xRg(C).Value) = YsNo Then

C = C - 1

End If

B = B + 1

End If

Next

Application.ScreenUpdating = True

End Sub

Then these to their appropriate sheet code modules.

Private Sub Worksheet_Change(ByVal Target As Range)

'Sub for Returned sheet

Dim ToSht As String
Dim FroSht As String
Dim YsNo As String
Dim Z As Long
Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then
'********************************
YsNo = "no"
'**********************************
Call MoveBasedOnValue(YsNo)

End If

Next

Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'Sub for Returned sheet

Dim ToSht As String
Dim FroSht As String
Dim YsNo As String
Dim Z As Long
Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then
'********************************
YsNo = "yes"
'**********************************
Call MoveBasedOnValue(YsNo)

End If

Next

Application.EnableEvents = True

End Sub

Hope that helps.

Works Perfectly! Thank you so much. I'm just starting to use VBA on some of my sheets, and right now the extent of my knowledge is copying and pasting a code that does close to what I want, and then just changing a few trigger words or sheet names to fit my needs. Hoping to improve my skills in the near future. Thanks Again!