Transfer new row under headings

Hi Treacy,

I assume that you were actually referring to me rather than the OP. The code modified as follows may actually suit you better:-


Code:
Sub Test()

Application.ScreenUpdating = False

With Sheet1.[A1].CurrentRegion
        .AutoFilter 9, "Closed"
        .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
        .Offset(1).EntireRow.Delete
        .AutoFilter
End With

Application.ScreenUpdating = True

End Sub

Test it in a copy of your actual workbook first and let us know how it goes.

BTW. You may want to change your nick-name. Its not a good idea to use your email as a nick-name.

I hope that this helps.

Cheerio,
vcoolio.
 
@treacy
Welcome to the forum. :)

We are happy to help, however whilst you feel your request is similar to this thread, experience has shown that things soon get confusing when answers refer to particular cells/ranges/sheets which are unique to your post and not relevant to the original. Please start a new thread - I did it for you this time
 
Yes, I was referring to you vcoolio. My apologies. Thanks so much for replying.
 
Hi Treacy,

You're welcome. The obvious question now is: Did the code in post #2 work for you?

Cheerio,
vcoolio.
 
No. I changed some row and column references to suit my project. But it is not working. Can I upload the file here if u had time to look at it. I am new to this site.
 
Hello Treacy,

Just a slight modification as follows:-

Code:
Sub Test()

Application.ScreenUpdating = False

With Sheet1.[A1].CurrentRegion  '----> Sheet1 is the sheet code for the sheet name "Sheet2".
        .AutoFilter 2, "Yes"
         .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2) '  ----> Sheet2 is the sheet code for the sheet name "Sheet1".
        .Offset(1).EntireRow.Delete
        .AutoFilter
End With

Sheet2.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

The sheet code/sheet name may have confused you.

I noticed that you placed the code into the worksheet module. This code is not an event code and needs to be placed into a standard module and assigned to a button. Were you wanting to use an event code (no buttons)? An event code would immediately transfer the data as soon as "Yes" is placed into any cell in Column B.

I hope that this helps.

Cheerio,
vcoolio.
 
Hi Treacy,

Try the following event code:-


Code:
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns(2)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Application.ScreenUpdating = False

Sheet2.Rows(2).EntireRow.Insert

If Target.Value = "Yes" Then
Target.EntireRow.Copy Sheet2.[A2]
Target.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub

You need to make sure that "Yes" is the last entry in each row as the cells in Column B are the trigger for the event code.
Once you enter "Yes" in any cell in Column B then click away (or press enter or down arrow) the code will transfer the relevant row of data to the destination sheet.

To implement this code:-

- Right click on the source sheet tab.
- Select "View Code" from the menu that appears.
- In the big white code field that then appears, paste the above code.

Test it in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.
 
Last edited:
That is brilliant. Thank you for being so generous with your time. It deletes the row and places the most recent row where I want. You are a gentleman. Thanks again
 
Hi Treacy,

Wow! Thanks for the kind words.

You're welcome. I'm glad to have been able to assist and I'm glad that it now all works for you.

(remember to change your nick-name!!)

Cheerio,
vcoolio.
 
You mentioned that Yes in Column 2 had to be entered last. It would make more sense to make the Date Received (Column C) the trigger and Delete the Received (Column B) altogether. Would that require much alteration of the code. Once a date is entered in the Date Received Column, that means a reply has been received anyway.
 
Hi Treacy,

Amend the code as follows:-


Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns([COLOR=#ff0000]3[/COLOR])) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Application.ScreenUpdating = False

Sheet2.Rows(2).EntireRow.Insert

[COLOR=#ff0000]If IsDate(Target.Value) Then[/COLOR]
Target.EntireRow.Copy Sheet2.[A2]
Target.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub

Just be careful though because if you delete Column B, Column C (Date Received) will then become Column B or Column2. Hence, in this line of code:-

Code:
If Intersect(Target, Columns([COLOR=#ff0000]3[/COLOR])) Is Nothing Then Exit Sub

you may still need to leave the 3 as 2.

I hope that this helps.

Cheerio,
vcoolio.
 
Back
Top