Macro to dynamically copy and paste an entire row of data from one worksheet to another worksheet based on a cell value

[dkman718]

I am new to MrExcel and to VBA in general so I apologize if this has been answered directly elsewhere, however all of the searching I have done has led to partial answers and I am just not savvy enough to piece together multiple solutions for what I am looking for so hoping someone can help.

Within a large workbook, I have a worksheet with 100 rows with 46 columns of various data types for which I need to copy over each individual row of data where a user selects YES within the respective cell in column AN to another worksheet; I only want to copy the rows that have YES chosen and my goal is for the copying to be both automatic and dynamic (user selects YES, it copies; user selects NO, it doesn't; user can also change from one to the other and it copies or removes based on the response). If the user selects YES on 50 out of 100 rows, then the 2nd worksheet should only display 50 rows...I found an "answer" to this question on Ozgrid.com from back in 2013 however I cannot get that code to properly work on my EXCEL 365 version file even though I can literally open the test file and see it working so I believe this is possible. Am I crazy? I am attaching a generic file that mirrors my actual one as an example and would appreciate any answer that actually provides coding as opposed to "please search the archives since this has been asked before" as I am struggling at this point.

One additional note specific to this request (because the above wasn't annoying enough) - I had to add a minor macro (one I was able to figure out) to clear dependent drop down list selections if the main drop down selection was changed which is included in the WORKSHEET module and has proved to be a bigger thorn in my side because I have been trying to figure out also how to combine it with a solution for my copy and paste question; I will paste the code I entered shortly (have to change machines) but hoping whoever can help me with the above can figure out how to combine with the existing macro or I will probably be back to square one again.

Thank you in advance for any and all assistance!

 

[dkman718]

Well, strike that from the record about the file - apparently I cannot attach the file and I have no way to "link it" either. Hopefully my description above helps.

At least I have the code for the dependent drop down clearing macro to add now so that is at least a win

Private Sub Worksheet_Change(ByVal target As Range)
Dim a As Range, c As Long, MyRanges As Range

    Set MyRanges = Range("A:C")
    
    On Error Resume Next
    Application.EnableEvents = False
    
    For Each a In MyRanges.Areas
        If Not Intersect(target, a) Is Nothing Then
            Intersect(target.Offset(, 1).Resize(, 3), a).ClearContents
        End If
    Next a
    
    Application.EnableEvents = True
End Sub

 

[vcoolio]

Hello DKMan,

You can upload a sample file to a free file sharing site such as WeTransfer or Drop Box then post the link to your file back here.

See if this at least is heading in the right direction:-

Sub Test()

Application.ScreenUpdating = False

Sheet2.UsedRange.Offset(1).Clear

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

Application.ScreenUpdating = True

End Sub

The code assumes that your data in Sheet1 starts in row2 with headings in row1 and Column A is the actual first column used.
The destination sheet (Sheet2) is cleared prior to each transfer of data.

I hope that this helps.

Cheerio,
vcoolio.

 

[dkman718]

Vcoolio,

This is absolutely a HUGE move in the right direction, thank you so much; this code does copy the rows with YES over to the 2nd tab which is what I am looking for, however it is requiring me to F5 the doc from VBA to update - is there a way for it to be "dynamic" and just automatically update without any user interaction with VBA? If you can solve for that, I might just be golden.

Also, thank goodness for WeTransfer (I think)...link to my test file below:

MrExcel Test Workbook 6-17-21.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Please let me know if you cannot access that and I will attempt other options to post.

Thank you again for your help!

 

[dkman718]

My apologies, please use this link as I noticed the generic SHEET1 and SHEET2 names were not translating to my actual file and figured I should just include that in the request.

MrExcel Test Workbook 6-17-21.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Thank you again!

 

[dkman718]

I think I should have stayed in bed last night AND this morning with the way things are going here.

I figured out the Sheet ID piece so the actual tab names apparently don't matter, however I noticed in my original description AND the earlier files that I sent that there is only one header row at top; unfortunately my real file has 2 rows in the header so the data starts at Row 3 instead. The newly attached file now has 2 header rows with data starting at Row 3; I gave a shot at updating the code you provided (just changed the OFFSET from 1 to 2?) which appears to copy correctly on this test file, however when I try that over on my real file I get a run time error so hoping this can be worked in to the what is now 47 responses I have already posted.

MrExcel Test Workbook 6-17-21.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Please accept my apologies for the multiple follow ups and again thank you for your assistance!

 

[vcoolio]

Hello DKMan,

Thanks for the sample. The code, slightly amended as follows, should do the task for you:-

Option Explicit
Sub Test()

Application.ScreenUpdating = False

Sheet2.UsedRange.Offset(2).Clear

        With Sheet1.Range("AN2", Sheet1.Range("AN" & Sheet1.Rows.Count).End(xlUp))
                .AutoFilter 1, "Yes"
                .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

Just to test, I added a few extra "Yes" criteria in Column AN (there is only one in your sample) and all worked just fine.
I'm glad that you worked out that the sheet names are irrelevant to the code and that the corresponding sheet code is all that you need to reference. Hence, should the sheet names be changed in future, the code will still work regardless.

Things that you may want to note:-
- The first row in your sample is merged. Merged cells generally create havoc with sub-routines so if rows 1 and 2 in your actual workbook are merged, un-merge them. You can still format cells without merging them.
- You placed the VBA code into the sheet("Initial Request") module. The code supplied is not an event code and, to work correctly, needs to be placed into a standard module then assigned to a button or shortcut key.

Hopefully you'll be able to sleep more peacefully now!

Cheerio,
vcoolio.

 

[dkman718]

Thank you again Vcoolio - is there possibly any way to do this automatically without assigning to a button? The end users utilizing this file make me look the Einstein of VBA and I am not confident they will be able to handle this option so figured I would ask.

The MERGE thing is also a problem...Row 1 on my actual file is a significant number of merged cells as informative headers that are also critical for the users. Is there anyway around that or do I need to find another solution for the merging portion also?

 

[dkman718]

On a side note, your code absolutely worked perfectly on my test file once I got rid of the merge at the top.

 

[vcoolio]

The MERGE thing is also a problem...Row 1 on my actual file is a significant number of merged cells as informative headers that are also critical for the users. Is there anyway around that or do I need to find another solution for the merging portion also?

Hello DkMan,

If your actual column headings are in row 2 and this row doesn't have any merged cells (and you don't want or need merged cells in a headings row) then the code in post #7 will work for you. It will ignore row1 with the merged cells.

Thank you again Vcoolio - is there possibly any way to do this automatically without assigning to a button? The end users utilizing this file make me look the Einstein of VBA and I am not confident they will be able to handle this option so figured I would ask.

Haha! A good case for a pay rise!

The Users wouldn't be able to handle clicking on a button when required?

You could change the code to an event code which would have each row transferred over once "Yes" is entered in a cell in Column AN (or selected from a drop down). This would happen one row at a time BUT the criteria "Yes" must be the last entry made on any row:-

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

Application.ScreenUpdating = False
Application.EnableEvents = False
        
        If Intersect(Target, Columns(40)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub
        
        If Target.Value = "Yes" Then
              Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
        End If
    
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Place this code into the sheet ("Initial Request) module but ensure you delete the other event code that you already have there.

....................or you could just call the "Test" sub-routine from an event code:-

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

Application.ScreenUpdating = False
Application.EnableEvents = False
        
        If Intersect(Target, Columns(40)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub
        Test
    
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

This will "gather" all the "Yes" criteria in the Column and transfer all the relevant rows at once. With this code, you'll need to still place the "Test" sub-routine into a standard module and the above code into the sheet ("Initial Request") module. Again, remove the other event code that is already in the sheet module.

...............or just have the whole routine run from the sheet module:-

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

Application.ScreenUpdating = False
Application.EnableEvents = False
        
        If Intersect(Target, Columns(40)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub
        
        If Target.Value = "Yes" Then
                Sheet2.UsedRange.Offset(2).Clear
        
                With Sheet1.Range("AN2", Sheet1.Range("AN" & Sheet1.Rows.Count).End(xlUp))
                        .AutoFilter 1, Target.Value  '---->Can change Target.Value to "Yes" if you like.
                        .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                        .AutoFilter
                End With
        End If
        
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Again, with the last two options above, "Yes" must be the last entry.

I hope that this helps.

Cheerio,
vcoolio.