Comparing dates

[Mr. Dan]

Hello,

I would like to run a sub everytime a worksheet is opened that compares
todays date with a series of dates listed in column A. Cell A1 would, for
example, have May-05 (5/1/2005), cell A2 would have Jun-05 (6/1/2005), etc.

If todays month and year match up to a cell in the A column, then a value
from that row (maybe 5 cells over) is pasted into another worksheet.

Been playing around with this for a while and just can't get it!

Thanks in advance,
Dan

[Toppers]

Dan,

Try this and change sheets etc as needed :

Sub Compare_Dates()

Dim lastrow As Long, r1 As Long, r2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
r2 = 2

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row

For r1 = 2 To lastrow
If Format(.Cells(r1, 1), "MMYY") = Format(Now(), "MMYY") Then
.Cells(r1, 1).Offset(0, 5).Copy ws2.Cells(r2, 1) '<=== change as
required
r2 = r2 + 1
End If
Next r1
End With
End Sub


"Mr. Dan" wrote:

> Hello,
>
> I would like to run a sub everytime a worksheet is opened that compares
> todays date with a series of dates listed in column A. Cell A1 would, for
> example, have May-05 (5/1/2005), cell A2 would have Jun-05 (6/1/2005), etc.
>
> If todays month and year match up to a cell in the A column, then a value
> from that row (maybe 5 cells over) is pasted into another worksheet.
>
> Been playing around with this for a while and just can't get it!
>
> Thanks in advance,
> Dan

[Mr. Dan]

Hello Toppers,

Thanks for the quick response. Unfortunately, I'm getting a 'run-time error
1004: application-defined or object-defined error'. Here's the entire code
I'm using including your recommended text. Can you see where I'm missing
something?

D4 is the destination cell in the "Summary" worksheet where a number will
ultimately be returned.

Thanks again!!!
Dan



Private Sub Workbook_Open()
Dim answer As Integer
Dim lastrow As Long, r1 As Long, r2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
If Weekday(Now) > 1 And Weekday(Now) < 7 Then
If Date = Sheets("Data").Range("A1").Value Then
Exit Sub
End If
If Time < 0.7916667 Then
answer = MsgBox("It's before 7:00PM on a weekday. Update the
quotes including performance?", vbYesNo)
Select Case answer
Case vbYes
Call update_quotes
Case vbNo
GoTo heloc_calc
End Select
Sheets("Summary").Activate
Range("A1").Select
Else
Call update_quotes
End If
End If
heloc_calc:

Set ws1 = Worksheets("HELOC")
Set ws2 = Worksheets("Summary")
r2 = 2

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row

For r1 = 2 To lastrow
If Format(.Cells(r1, 1), "MMYY") = Format(Now(), "MMYY")
Then
.Cells(r1, 1).Offset(0, 6).Copy ws2.Cells(r2, 4)
'<=== change as Required
r2 = r2 + 1
End If
Next r1
End With

Sheets("Summary").Activate
Range("A1").Select

End Sub








"Toppers" wrote:

> Dan,
>
> Try this and change sheets etc as needed :
>
> Sub Compare_Dates()
>
> Dim lastrow As Long, r1 As Long, r2 As Long
> Dim ws1 As Worksheet, ws2 As Worksheet
>
> Set ws1 = Worksheets("Sheet1")
> Set ws2 = Worksheets("Sheet2")
> r2 = 2
>
> With ws1
> lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
>
> For r1 = 2 To lastrow
> If Format(.Cells(r1, 1), "MMYY") = Format(Now(), "MMYY") Then
> .Cells(r1, 1).Offset(0, 5).Copy ws2.Cells(r2, 1) '<=== change as
> required
> r2 = r2 + 1
> End If
> Next r1
> End With
> End Sub
>
>
> "Mr. Dan" wrote:
>
> > Hello,
> >
> > I would like to run a sub everytime a worksheet is opened that compares
> > todays date with a series of dates listed in column A. Cell A1 would, for
> > example, have May-05 (5/1/2005), cell A2 would have Jun-05 (6/1/2005), etc.
> >
> > If todays month and year match up to a cell in the A column, then a value
> > from that row (maybe 5 cells over) is pasted into another worksheet.
> >
> > Been playing around with this for a while and just can't get it!
> >
> > Thanks in advance,
> > Dan

[Toppers]

Dan,
I ran your code and it works OK for me. I assume you get the
error in my code - what version of Excel are you using? (I am XL2003 and it
might be that the FORMAT statement is not supported by earlier versions - not
sure myself to be honest).

You could replace the IF test as shown below. If you still have problems,
post the workbook to me ( [email protected])

With ws1
.Activate
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For r1 = 2 To lastrow
If Month(.Cells(r1, 1)) & Year(.Cells(r1, 1)) =
Month(Now()) & Year(Now()) Then '
.Cells(r1, 1).Offset(0, 6).Copy ws2.Cells(r2, 4)
r2 = r2 + 1
End If
Next r1
End With
"Mr. Dan" wrote:

> Hello Toppers,
>
> Thanks for the quick response. Unfortunately, I'm getting a 'run-time error
> 1004: application-defined or object-defined error'. Here's the entire code
> I'm using including your recommended text. Can you see where I'm missing
> something?
>
> D4 is the destination cell in the "Summary" worksheet where a number will
> ultimately be returned.
>
> Thanks again!!!
> Dan
>
>
>
> Private Sub Workbook_Open()
> Dim answer As Integer
> Dim lastrow As Long, r1 As Long, r2 As Long
> Dim ws1 As Worksheet, ws2 As Worksheet
> If Weekday(Now) > 1 And Weekday(Now) < 7 Then
> If Date = Sheets("Data").Range("A1").Value Then
> Exit Sub
> End If
> If Time < 0.7916667 Then
> answer = MsgBox("It's before 7:00PM on a weekday. Update the
> quotes including performance?", vbYesNo)
> Select Case answer
> Case vbYes
> Call update_quotes
> Case vbNo
> GoTo heloc_calc
> End Select
> Sheets("Summary").Activate
> Range("A1").Select
> Else
> Call update_quotes
> End If
> End If
> heloc_calc:
>
> Set ws1 = Worksheets("HELOC")
> Set ws2 = Worksheets("Summary")
> r2 = 2
>
> With ws1
> lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
>
> For r1 = 2 To lastrow
> If Format(.Cells(r1, 1), "MMYY") = Format(Now(), "MMYY")
> Then
> .Cells(r1, 1).Offset(0, 6).Copy ws2.Cells(r2, 4)
> '<=== change as Required
> r2 = r2 + 1
> End If
> Next r1
> End With
>
> Sheets("Summary").Activate
> Range("A1").Select
>
> End Sub
>
>
>
>
>
>
>
>
> "Toppers" wrote:
>
> > Dan,
> >
> > Try this and change sheets etc as needed :
> >
> > Sub Compare_Dates()
> >
> > Dim lastrow As Long, r1 As Long, r2 As Long
> > Dim ws1 As Worksheet, ws2 As Worksheet
> >
> > Set ws1 = Worksheets("Sheet1")
> > Set ws2 = Worksheets("Sheet2")
> > r2 = 2
> >
> > With ws1
> > lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
> >
> > For r1 = 2 To lastrow
> > If Format(.Cells(r1, 1), "MMYY") = Format(Now(), "MMYY") Then
> > .Cells(r1, 1).Offset(0, 5).Copy ws2.Cells(r2, 1) '<=== change as
> > required
> > r2 = r2 + 1
> > End If
> > Next r1
> > End With
> > End Sub
> >
> >
> > "Mr. Dan" wrote:
> >
> > > Hello,
> > >
> > > I would like to run a sub everytime a worksheet is opened that compares
> > > todays date with a series of dates listed in column A. Cell A1 would, for
> > > example, have May-05 (5/1/2005), cell A2 would have Jun-05 (6/1/2005), etc.
> > >
> > > If todays month and year match up to a cell in the A column, then a value
> > > from that row (maybe 5 cells over) is pasted into another worksheet.
> > >
> > > Been playing around with this for a while and just can't get it!
> > >
> > > Thanks in advance,
> > > Dan