Copy & Paste - Automatically

[SG666]

Hi all,

I know this has come up a million times before, and I have search for the answer and seemed to find some, but when I try to use the code it doesn't seem to work for me, as it deletes the original row or wont paste into the correct area on my second worksheet.

What I'd like to do is be able to fill in the below example, and when i choose FAIL it will copy the entire row into the next available row on the Failures worksheet

So that the above "test" would result in a failure list as per the below example...

This is the code that I'd found online to try and edit to fit my needs but I'm struggling to get it to work with my VERY basic knowledge of macros....

Sub MoveBasedonValue()

Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long

A = Worksheets("master").UsedRange.Rows.Count
B = Worksheets("completed").UsedRange.Rows.Count

If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("completed").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("master").Range("D1:D" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Done" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("completed").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Done" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Any help with getting this working would be fantastic and greatly appreciated!!

Thanks,
Shwan

 

[HaHoBe]

Hi SG666,

on sheet Report the first line of entries is 10, Column to check is "J", entry must be "Fail" (I changed the value to be lower case "fail"), first line on sheet Failures will be the first free row as that is a variable which will be calculated on each run.

You would need to give us information about where the data is located (row number and columns to copy) and what the contents of the first row are.

Holger

 

[SG666]

Hi,

Sorry this is probably taking longer then you might have hoped.

I have duplicated the Reports WS so that the Failures WS looks exactly the same, so in theory the items that disappear from "Reports" should reappear in the available rows within "Failures" (i have removed the original Failures to avoid conflicts), however this still doesn't work. They will disappear from Reports, but wont appear on Failures.

The below screengrab shows the kind of data that will be input, you can see that this is within the WS "Reports", the result column is empty at present but its a dropdown list that allows the choice of either Pass or Fail.

If i choose Fail from row 10, column J it will disappear from that worksheet, but nothing happens on the other worksheet.

I hope this helps, and thank you so far for you help and patience!

 

[HaHoBe]

Hi SG666,

please find my sample workbook here where you can check after download if the procedure is triggered once any status on Report is changed to Fail.

Ciao,
Holger

 

[SG666]

Thanks for this, seems to work perfectly!

How hard is it to change the code to get it to only copy on the data from the Report to the Failures and not delete it after?

 

[HaHoBe]

Hi SG666,

instead of

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  If LCase(Target.Value) = "fail" Then
    Set wsFailures = Worksheets("Failures")
    lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
    wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = Range("A" & Target.Row & ":J" & Target.Row).Value
    Application.EnableEvents = False
    Range("A" & Target.Row & ":J" & Target.Row).Delete
    Application.EnableEvents = True
    Set wsFailures = Nothing
  End If
End If

which will delete either comment the lines

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  If LCase(Target.Value) = "fail" Then
    Set wsFailures = Worksheets("Failures")
    lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
    wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = Range("A" & Target.Row & ":J" & Target.Row).Value
'    Application.EnableEvents = False
'    Range("A" & Target.Row & ":J" & Target.Row).Delete
'    Application.EnableEvents = True
    Set wsFailures = Nothing
  End If
End If

or delete the commented lines. I would take a different route here to opt for both possibilties by using a Boolean to determine whether to delete or not like

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngWrite As Long
Dim wsFailures As Worksheet

Const cblnKeep As Boolean = True      'True means keep Data, False will delete

If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 10 Then Exit Sub

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  If LCase(Target.Value) = "fail" Then
    Set wsFailures = Worksheets("Failures")
    lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
    wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = Range("A" & Target.Row & ":J" & Target.Row).Value
    If Not cblnKeep Then
      Application.EnableEvents = False
      Range("A" & Target.Row & ":J" & Target.Row).Delete
      Application.EnableEvents = True
    End If
    Set wsFailures = Nothing
  End If
End If

End Sub

Ciao,
Holger

 

[SG666]

This is great thanks!

So am I right in thinking if i use the last example (with the Boolean) I can change the below from either True (to keep the data that has been copied) or False (to delete it once its been copied) ?

Const cblnKeep As Boolean = True

 

[HaHoBe]

Hi SG666,

you're right on this.

Holger