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]

Vcoolio - those are tremendous options, however I am stuck keeping the existing event code in there because I have to be able to clear multiple dependent drop down options if someone changes their original selection so I think I need to focus on the first option and FORCE THESE SUCKAS to hit a button

I've already load that and I rejoiced when I finally had row copy over, however I noticed one issue; the code is set to clear Sheet2 however I want to paste the row into existing (and identical fields) on Sheet2. I attempted to delete that line which worked, however then the copy and pasted cells were out of alignment and I could not figure out where I went awry.

Thoughts on that? You are an absolute lifesaver by the way!!

 

[vcoolio]

Hello DKMan,

Fields refers to columns so I'm not sure what you mean. The code copies the row from (fields) Column A to Column AT and pastes each row from Column A on so each column in the destination sheet has identical information from the source sheet. Hence, if you've removed the 'clear' line of code, each newly transferred row of data will be pasted to the next available row in the destination sheet from Column A on.
BTW, removing the 'clear' line of code will cause you a duplication problem in the destination sheet. Hence, should the transferred row of data be deleted from the source sheet?

You may have to elaborate a little more.

Cheerio,
vcoolio.

 

[vcoolio]

Hello DKMan,

I forgot to mention earlier that you can have two WorkSheet_Change event codes in the one sheet module:-

Option Compare Text
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.ScreenUpdating = False
    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
         
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Not Intersect(Target, Columns(40)) Is Nothing Then
    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
    End If
        
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

I'm assuming that the one you have written works as it should.

Cheerio,
vcoolio.

 

[dkman718]

Good morning Vcoolio,

So I tried the new code you provided above on my test sheet and it works great, even automatically copying my rows over to the 2nd 'Physical Site Request' tab; my only concern now is (and I updated the attached file to show this) is that when I do enter YES in AN and it copies to the 2nd tab it deletes the existing formatted cells on the 2nd tab in favor of the new copied ones. On my master file there are some totaling calculations at the bottom of the data of the 2nd sheet so need to know if it is possible to keep the existing row formatting on my 2nd sheet and just have the copied rows paste into those field formatted as is?

The newly attached file has all NOs presently in AN and the general formatting I want to keep on the 2nd tab so you can see exactly what I am referring to above.

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 for all your help here.

 

[vcoolio]

Hello DKMan,

A slight amendment to the code in post #13 should take care of that:-

Option Compare Text
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.ScreenUpdating = False
    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
         
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Not Intersect(Target, Columns(40)) Is Nothing Then
    If Target.Value = "Yes" Then
            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).Resize(.Rows.Count - 1).EntireRow.Copy
                    Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                    .AutoFilter
            End With
    End If
    End If
        
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

The 'clear' line of code has been removed but the question of duplication remains (post #12).

Cheerio,
vcoolio.

 

[vcoolio]

BTW DKMan, if you require that all data is not deleted from the source sheet and duplication is a problem in the destination sheet, then add this line of code:-

Sheet2.UsedRange.Offset(2).SpecialCells(2, 23).ClearContents

directly after this line of code:-

If Target.Value = "Yes" Then

This will clear the contents of the destination sheet (except the headings row) but will preserve any formulae that you have in the destination sheet. There mustn't be any formulae in Column A of the destination sheet though.

Cheerio,
vcoolio.

 

[dkman718]

Vcoolio,

So the code you provided in Response #15 (and a little of #16) works perfectly for what I was asking for originally, however it has led to a follow up question; when I only have one workbook open, the macro runs great, however whenever I have a 2nd workbook at the same time it will not run at all. I have seen some examples of coding that include reference to "ThisWorkbook" as a solution but have thus far been unable to figure out where I might add that to your earlier code OR if it is even necessary and perhaps I have a separate issue. Any thoughts on this?

 

[vcoolio]

Hello DKMan,

As I write this response, I have two workbooks open and each are operating independently of each other without any issues. All macros do the tasks as assigned. Event codes are specific to the sheet into which they are placed.
I noticed that you are using Office 365 as am I (subscribed version) so I'm not sure why you would be experiencing the problem and, as you correctly suggested, it's not necessary to use "ThisWorkbook".
However, the additional qualification just might work:

Option Compare Text
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.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each a In ThisWorkbook.Sheets("Initial Request").MyRanges.Areas
        If Not Intersect(Target, a) Is Nothing Then
            Intersect(Target.Offset(, 1).Resize(, 3), a).ClearContents
        End If
    Next a
         
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    If Not Intersect(Target, Columns(40)) Is Nothing Then
    If Target.Value = "Yes" Then
            With ThisWorkbook.Sheets("Initial Request").Range("AN2", Range("AN" & Rows.Count).End(xlUp))
                    .AutoFilter 1, Target.Value  '---->Can change Target.Value to "Yes" if you like.
                    .Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy
                    ThisWorkbook.Sheets("Physical Site Request").Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                    .AutoFilter
            End With
    End If
    End If
        
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

If this still doesn't sort it out then try putting the code I supplied back into a standard module and assign it to a button as previously suggested and leave your event code in the sheet module. Separating the two just may work.

Cheerio,
vcoolio.

 

[dkman718]

Vcoolio - you are absolutely outstanding! The above update 100% did the trick and I am now fully rocking and rolling along. My intent is to mark this issue as SOLVED, however unless you are opposed I thought maybe I would leave it open through early next week just in case

Again, thank you so much for you help as this was a daunting request from my perspective and you crushed it - many thanks and stay safe!

 

[vcoolio]

Hello DKMan,

You're welcome. I'm glad to have been able to assist and thanks for the feed back.

Cheerio,
vcoolio.