Macro to copy and paste multiple cells if row contains date within range

[jessigem]

Hello everyone,

I have a macro set up that asks for a beginning date and an ending date, then scans columns J-Y for a date that falls within that range. If the macro finds a valid date, it copies and pastes the cell containing the date and the cell directly to the right of it onto another sheet (ex: if date is in column J, it copies J+K from that row).

What I need it to do is copy and paste the cells in columns B,D,E,F,G, as well as the cell containing the date and the cell directly to the right (all from the same row). I can't figure out how to alter the code to capture non-adjacent cells in the row.

BONUS: It would be great if the macro just copied the values in the cells without formatting. This isn't necessary for the purpose of the sheet, but it would make everything look cleaner.

I've been researching this code for 2-3 weeks now and I finally have to throw in the towel and ask for advice from brilliant people like yourselves. Any help would be greatly appreciated.

Sub SanDiego_Releases()


    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("San Diego")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            'I assume the below is where the problem is...
            c.Offset(1, 0).Resize(1, 2).Copy _
                          shtDest.Cells(destRow, 4)


            destRow = destRow + 1


        End If
    Next


End Sub

 

[Fishboy]

Hello everyone,

I have a macro set up that asks for a beginning date and an ending date, then scans columns J-Y for a date that falls within that range. If the macro finds a valid date, it copies and pastes the cell containing the date and the cell directly to the right of it onto another sheet (ex: if date is in column J, it copies J+K from that row).

What I need it to do is copy and paste the cells in columns B,D,E,F,G, as well as the cell containing the date and the cell directly to the right (all from the same row). I can't figure out how to alter the code to capture non-adjacent cells in the row.

BONUS: It would be great if the macro just copied the values in the cells without formatting. This isn't necessary for the purpose of the sheet, but it would make everything look cleaner.

I've been researching this code for 2-3 weeks now and I finally have to throw in the towel and ask for advice from brilliant people like yourselves. Any help would be greatly appreciated.

Sub SanDiego_Releases()


    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("San Diego")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            'I assume the below is where the problem is...
            c.Offset(1, 0).Resize(1, 2).Copy _
                          shtDest.Cells(destRow, 4)


            destRow = destRow + 1


        End If
    Next


End Sub

Hi jessigem, welcome to the boards.

This is untested as I do not have the same data layout as you. I assume that if you were already pasting to (destRow,4) then would cell B be pasted to (destRow,4), cells D:G would be pasted to (destRow,5) through to (destRow,8), then the last 2 cells would be pasted to (destRow,9) and (destRow,10)?

Sub SanDiego_Releases()
    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("San Diego")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial xlPasteValues
                    Range("D" & c.Row, "G" & c.Row).Copy
                        shtDest.Cells(destRow, 5).PasteSpecial xlPasteValues
                            Range(c, c.Offset(0, 1)).Copy
                                shtDest.Cells(destRow, 9).PasteSpecial xlPasteValues
                                    destRow = destRow + 1


        End If
    Next


End Sub

 

[jessigem]

Hi jessigem, welcome to the boards.

This is untested as I do not have the same data layout as you. I assume that if you were already pasting to (destRow,4) then would cell B be pasted to (destRow,4), cells D:G would be pasted to (destRow,5) through to (destRow,8), then the last 2 cells would be pasted to (destRow,9) and (destRow,10)?

Thank you! Yes, that assumption is correct. There are a couple issues with the fixed code:

1. The macro output blank cells for B & D-G. It did output correct data for the cell containing the date and adjacent cell.
2. The date was output as a string of numbers. I know I asked for the cells to paste unformatted, but I do need the date to remain as MM/DD/YYYY.

Below are a couple screenshots of the Source sheet and Dest Sheet so you can see what happened and what it should be pulling. **Sorry about the dropbox links, I know it's a no-no but I don't know how to post an image on here.

https://www.dropbox.com/s/5uqwd1zaeygw1kc/Excel Dest Sheet.png?dl=0

https://www.dropbox.com/s/l6j5xk6qghqoqdk/Excel Source Sheet.png?dl=0

 

[jessigem]

Fishboy, I googled around a bit and solved the issues. I had to reference the source sheet for range B & D-G or else it was just pulling from the destination sheet (I have no idea why).
The code below generates the output I needed. I haven't had any bugs occur yet, but if you see any ways to improve it I'm all ears.

Thanks again for your help!! You steered me in the right direction

Sub SanDiego_Releases()

    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("San Diego")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            Sheet2.Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                    Sheet2.Range("D" & c.Row, "G" & c.Row).Copy
                        shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                            Range(c, c.Offset(0, 1)).Copy
                                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                    destRow = destRow + 1
        End If
    Next


End Sub

 

[Fishboy]

Fishboy, I googled around a bit and solved the issues. I had to reference the source sheet for range B & D-G or else it was just pulling from the destination sheet (I have no idea why).
The code below generates the output I needed. I haven't had any bugs occur yet, but if you see any ways to improve it I'm all ears.

Thanks again for your help!! You steered me in the right direction

Sub SanDiego_Releases()

    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("San Diego")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            Sheet2.Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                    Sheet2.Range("D" & c.Row, "G" & c.Row).Copy
                        shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                            Range(c, c.Offset(0, 1)).Copy
                                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                    destRow = destRow + 1
        End If
    Next


End Sub

Glad to hear you got it working

I think the reason you will have had to reference specific sheet names would be because otherwise Excel will consider any range to be on the "active" sheet, whatever that may be at the time.