VBA Code: Copy and Paste Range if requirements met

[malu89]

Hello dear members,

this is my first forum post ever on the VBA topic, and i am by no stretch skilled when it comes to programming.

I wanted a code that copies and pastes a specific range of cells when certain contitions are met. Here is what i got from https://excelribbon.tips.net/T013399...ext_Value.html

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")

    J = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("E1:E1000")   ' Do 1000 rows
        If c = "yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

As i needed to not copy the entire row of the range c i adjusted the code to give back a selection of cells in the row belonging to c by intersecting:

If c = "yes" Then
Intersect(Rows(c.Row), Range("A1:C5000,F1:H5000,R1:V5000")).Copy Target.Rows(j)

Which works fine, but slow when copying more than 500 ranges.

This is where i got so far, and just to give people with the same problem some code to try out.

The next step i need to make is the following:

I only want those instances of c = "yes" copied, where in the same row of c there is a date in column A that is equal to Month(Now).

I tried with If And like so:

If c = "yes" And Intersect(Rows(c.Row), Range("A1:A5000")) = Month(Now) Then

this code gave me no errors, but it also didnt copy anything. I tried to put these types of dates into A: MM/DD/YYYY, DD/MM/YYYY, MM/DD/YY, DD/MM/YY

Next i tried this one:

If c = "yes" And Month(Intersect(Rows(c.Row), Range("A1:A5000"))) = Month(Now) Then

which gives me runtime error 13, but the debugger does only give me the whole line of code as faulty.

If anyone has a solution to this, it would be greatly appreciated!

Special thanks to Doc Alan Elstein for helping me out and suggesting i put up my code on some forum!

[DocAElstein]

Hi there!

Welcome here at excelfox.

The first thing to check is to change …_
If c = "yes" And Month(Intersect(Rows(c.Row), Range("A1:A5000"))) = Month(Now) Then
_... to
If c = "yes" And Month(Intersect(Rows(c.Row), Range("A1:A5000")).Value) = Month(Now) Then

To explain :
Most people get in the bad habit of missing that out .Value. ( Even me sometimes Lol!!!!! :-) )

Using .Value on a range object ( Your Intersect(Rows(c.Row), Range("A1:A5000")) should give you a range object ) ensures that a value is returned rather than the range object. In 99% of the uses of a range object in a code, VBA guesses that you wanted the .Value, so it assumes that and adds it internally. So people get in the habit of missing it out to save a bit of typing.

_._________________-

The easiest way to take it further if you need more help would be to upload a reduced data test file:

Prepare a small, reduced row, test data sample of your file, that is to say the worksheet which you copy from. Change any sensitive/ private/ personal data, or just make data up.
Show an output/after worksheet which you prepare yourself/ fill in manually. That should show exactly the output that you want the coding to give you , based on your data worksheet
Choose the data carefully so that it tests all possible scenarios.
You only need a very small number of rows to develop the coding on: You may have noticed that the coding is usually written to work on the data that is there: The coding usually automatically adjusts to work on any amount of rows. But it is a lot easier to develop coding with a small amount of test data, that is to say a small amount of rows.


We can then get your current code working and possibly suggest some quicker alternatives, such as one I did recently here:
http://www.eileenslounge.com/viewtop...=31687#p245219


Alan


P.S. it is not obvious the first time around how to upload a file here. Here is some notes on it
http://www.excelfox.com/forum/showth...age9#post10769
If that proves difficult , then contact me privately and we will find a way for you to give me a file