Copy a Range that matches Todays date Q

[Sean]

How could I code the following in order to copy the current days
column

I have dates specified in A1:G1 (one of which will be TODAY)
My data for these dates is in A5:G30

I am looking to copy the data who's date (in A1:G1) equals TODAY, to
cells Z1:Z25

Thanks

 

[Don Guillett]

A bit more clarification on your layout
You could use a for/each loop

 

[Sean]

Don, layout looks like this

03/02/08 - 04/02/08 - 05/02/08 etc

134 - 762 - 323
32 - 209 - 1234
345 - 549 - 1862
etc - etc

I have a loop code that copies all columns, but above is more like a
lookup, in that if TODAY was 05/02/08 I would only want to copy the
range that shows 323; 1234; 1862 etc

 

[Don Guillett]

try
Sub copytodayscolumn()
mc = Rows(1).Find(Date).Column
'MsgBox mc
lr = Cells(Rows.Count, mc).End(xlUp).Row
'MsgBox lr
Range(Cells(2, mc), Cells(lr, mc)).Copy Range("z1")
End Sub

 

[Sean]

Don, thanks, two things on this

My dates are a formula eg. in cell B1is A1+1 etc etc, so the code
can't actually find a valid date. Also where is the 'paste' part in
the code, as I wish to have paste special values

 

[Don Guillett]

If your date in a1 is a date then the b1>>> dates will also be dates so date
will be found.
Please try to FULLY state your problem when you post. You said COPY ("I am
looking to copy"), not paste values. Here is the modification.

Sub copytodayscolumn()
mc = Rows(1).Find(Date).Column
'MsgBox mc
lr = Cells(Rows.Count, mc).End(xlUp).Row
'MsgBox lr
'Range(Cells(2, mc), Cells(lr, mc)).Copy Range("z1")
Range(Cells(2, "z"), Cells(lr, "z")).Value = _
Range(Cells(2, mc), Cells(lr, mc)).Value
End Sub

 

[Sean]

My date in A1 is also derived from a formula =TODAY()
+IF(WEEKDAY(TODAY())=1,0,IF(WEEKDAY(TODAY())=2,-1,8-WEEKDAY(TODAY())))

Hence I get a debug error of 'Object variable or With block variable
not set' if I hard code the dates, code works fine, is there a way to
overcme this?

 

[Don Guillett]

Sub copytodayscolumn()
'set a1
If Weekday(Date) = 1 Then x = 0
If Weekday(Date) = 2 Then x = -1
If Weekday(Date) >= 3 Then x = 8 - Weekday(Date)
Range("a1") = Date + x

mc = Rows(1).Find(Date, LookIn:=xlFormulas).Column
'MsgBox mc
lr = Cells(Rows.Count, mc).End(xlUp).Row
'MsgBox lr
'Range(Cells(2, mc), Cells(lr, mc)).Copy Range("z1")
Range(Cells(2, "e"), Cells(lr, "e")).Value = _
Range(Cells(2, mc), Cells(lr, mc)).Value
End Sub