Need Help With Finding Date And Copying Everything To The Right OfIt?

[Jenny Marlow]

Hey Guys,

I am stuck on a problem and would really appreciate some help with it.
I heard this is a good place to look for help. =)

I have sequential dates in Cells C3:IV3, with correlating data for
that date below it.

I need help creating a macro that would look for the first day of the
current week in the range C3:IV3 and once it is found, would copy all
cells to the right of it and paste it into Sheet2. Is this possible?

For example, for today, it would look for the date 4/13 in the range
C3:IV3. It finds that date in cell X3. It then would need to copy
cells X3:IV75 from the current sheet1 into sheet2.

I am having a hard time coming up with the logic for this. I am not an
expert user but need to get this done!! Any help would be greatly
appreciated!!!!!!

 

[Dave Peterson]

Why would it copy x3:iv75? How did you get that 75??? And where would it paste
that range?

This may get you kind of started, but it only copies the

Option Explicit
Sub testme()
Dim myDate As Date
Dim res As Variant
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range

'first day of week (Sunday)
myDate = Date + 1 - Weekday(Date)

With Worksheets("Sheet1")
Set myRng = .Range("c3:iv3")
res = Application.Match(CLng(myDate), myRng, 0)
If IsError(res) Then
MsgBox "Date not found!"
Exit Sub
End If

Set RngToCopy = .Range(myRng(res), .Cells(3, .Columns.Count))

End With

With Worksheets("Sheet2")
Set DestCell = .Range("a1")
End With

RngToCopy.Copy _
Destination:=DestCell

End Sub

========
If you want to copy a range based on the column that matches the Sunday of the
week and through the last used row of column C, you could modify that routine
like:

Option Explicit
Sub testme2()
Dim myDate As Date
Dim res As Variant
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim LastRow As Long

'first day of week (Sunday)
myDate = Date + 1 - Weekday(Date)

With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set myRng = .Range("c3:iv3")
res = Application.Match(CLng(myDate), myRng, 0)
If IsError(res) Then
MsgBox "Date not found!"
Exit Sub
End If

Set RngToCopy = .Range(myRng(res), .Cells(LastRow, .Columns.Count))

End With

With Worksheets("Sheet2")
Set DestCell = .Range("a1")
End With

RngToCopy.Copy _
Destination:=DestCell

End Sub

 

[Jenny Marlow]

Thanks Dave!! The one on the bottom works just great!!! Just one thing
tho, I know it's simple, but how do I paste values only? I tried

RngToCopy.Copy

Range("C3").Select

RngToPaste.PasteSpecial xlPasteValues

but that gave me an error. The code works just fine but I need to
paste the values only....

Thanks Dave, you really brightened my day by helping with this
stressful project!!

 

[Jenny Marlow]

I can't find my other response to this thread, but I wanted to delete
it because I figured out . I figured it out and it works just great!!
Thanks Dave for being of great help!! I made a couple changes to it
because of changed requirements but it really does the trick. Here is
my final code:

Sub testme2()
Dim myDate As Date
Dim res As Variant
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim LastRow As Long


'first day of week (Sunday)
myDate = (Date + 1 - Weekday(Date)) - 7


With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set myRng = .Range("c3:iv3")
res = Application.Match(CLng(myDate), myRng, 0)
If IsError(res) Then
MsgBox "Date not found!"
Exit Sub
End If


Set RngToCopy
= .Range(myRng(res), .Cells(LastRow, .Columns.Count))


End With


With Sheets(2)
Set DestCell = .Range("C3")
End With

RngToCopy.Copy
Sheets(2).Range("C3").PasteSpecial _
xlPasteValues










End Sub


Thanks again Dave, you are great! =)

 

[Dave Peterson]

You could have used:

With Sheets(2)
Set DestCell = .Range("C3")
End With

RngToCopy.Copy
DestCell.PasteSpecial paste:=xlPasteValues

I'm not sure I'd use Sheets(2). This means it'll be the second sheet from the
left. If that name doesn't change (and you know it), you could use:

With Worksheets("Sheet9999")