Comparing dates
 

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

Comparing dates
 

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

Comparing dates
 

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

Comparing dates
 

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 ( )

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