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]

Hi VCoolio - hoping you see this and glad I kept this open as I have encountered an issue...here is my current code:

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(45)) Is Nothing Then
    If Target.Value = "Yes" Then
    ThisWorkbook.Sheets("Physical Site Request").UsedRange.Offset(2).SpecialCells(2, 23).ClearContents
            With ThisWorkbook.Sheets("Initial Request").Range("AS2", Range("AS" & 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

The copy and paste portion continues to work great, however the original code to delete drop down entries has suddenly stopped working since we moved to specify ThisWorkbook; if I remove that option, then it stops working when more than one Workbook is open. Just to be clear, here is the specific part of the code I am referring to:

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

The include code only reflected "For Each a In MyRanges.Areas" which makes me think I need to rename the original MyRanges above it to match the ThisWorkbook inclusion (or some extra line of code to designate I mean THIS WORKBOOK). Any thoughts on how to address this?

Hope all is well, DKman718

 

[vcoolio]

Hello DKMan,

I can't recreate the problem you are having so could you please upload an actual working sample of your file with the codes implemented and also including the drop downs (dumb it down still), showing exactly what the first part of the code is actually supposed to do.

While you organise the sample, perhaps try:

1) Removing "On Error Resume Next". If there is an error causing the problem then removing this line will show us which error.
Or
2) Your code slightly modified as follows:-

    Dim MyRanges As Range
    Set MyRanges = Range("A:C")

    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    If Not Intersect(Target, MyRanges) Is Nothing Then
            Target.Offset(, 1).Resize(, 3).ClearContents
    End If

Another alternative is to leave your code as an event code and assigning the copy/paste code to a button as previously suggested.

Cheerio,
vcoolio.