copy cells from sheets based on date, paste to another sheet

**davegugg** · 10-21-2009, 04:44 PM

I am not sure if this will solve your problems, but I would assign Today = Date, not Now. Date is an integer for today, Now is a decimal. The way your code is written I believe Today would always be > txbDate.value, unless that value is tomorrow or later. Also, if txbDate is a text box, you may want to go CDate(txbDate.value) to turn the string into a date value.

Does that help?

**upod** · 10-21-2009, 04:51 PM

Thanks for your help. It is getting a bit late here and my wife has just arrived home so attention is needed elsewhere. I will try your suggestions tomorrow.

**upod** · 10-21-2009, 04:57 PM

Originally Posted by davegugg

...Today would always be > txbDate.value, unless that value is tomorrow or later. ...

Although true for most cases it is possible for the user to set up the schedule for future commitments.

**davegugg** · 10-21-2009, 05:08 PM

Originally Posted by upod

Although true for most cases it is possible for the user to set up the schedule for future commitments.

I just want to be sure you understand what happens when the current date is put into cbxDate.

**upod** · 10-22-2009, 06:15 AM

Well I am not sure the suggestions are helping (tbxDate, not txbDate) but I am getting a 1004 error "method select of object range failed" pointing at Range("I47").Select, the fifth line of code on the worksheet change

At the risk of repeating myself there are 2 distinct events; the first when the user sets up a schedule of future payment commitments, and the second based on a worksheet change. Because the first event makes an entry on the Receipts and Payments worksheet it triggers the second event, where it seems the problem lies.

After making the changes suggested by davegugg i have the following for the input form entries (have removed the error messages for empty textboxes and initialize ;

Private Sub CmdBtnOK_Click()

Dim Today
Today = Date



ActiveWorkbook.Sheets("CoA").Activate
Range("i47").Select

    Do
        If IsEmpty(ActiveCell) = False Then
            ActiveCell.Offset(1, 0).Select
        End If

    Loop Until IsEmpty(ActiveCell) = True
    
    ActiveCell.Value = tbxDate.Value
    ActiveCell.Offset(0, 1) = cbxFreq.Value
    ActiveCell.Offset(0, 2) = tbxTo.Value
    ActiveCell.Offset(0, 3) = tbxDesc.Value
    ActiveCell.Offset(0, 4) = tbxRef.Value
    ActiveCell.Offset(0, 5) = cbxAccount.Value
    ActiveCell.Offset(0, 6) = tbxAmount.Value


If CDate(tbxDate.Value) < Today Then

ActiveCell.Offset(0, 7) = tbxDate.Value ' to record on CoA first entry (below)

ActiveWorkbook.Sheets("Receipts & Payments").Activate
Range("a10").Select

    Do
        If IsEmpty(ActiveCell) = False Then
            ActiveCell.Offset(1, 0).Select
        End If

    Loop Until IsEmpty(ActiveCell) = True
    
    ActiveCell.Value = tbxDate.Value
    ActiveCell.Offset(0, 1) = tbxTo.Value
    ActiveCell.Offset(0, 2) = tbxDesc.Value
    ActiveCell.Offset(0, 3) = cbxAccount.Value
    ActiveCell.Offset(0, 4) = tbxRef.Value
    ActiveCell.Offset(0, 10) = tbxAmount.Value
End If

End Sub

and this is the revised code for the Receipts & Payments (sheet 9) change event

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
Dim Today
Today = Date
    
    Sheets("CoA").Select
    Range("I47").Select

    Do While ActiveCell.Value <> ""
        
        If ActiveCell.Value < Today Then ' checks to see if contract date is before the present date - if yes go to next evaluation
        
            If ActiveCell.Offset(0, 7).Value = "" Then ' if there is no previous accounting entry date then
                
                If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then ' if contract start plus one frequency period is before present date
                     Call enterdata                   ' create entries on Receipts & Payments
                                    
                End If
                
            Else
                If ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then    ' if last entry plus one frequency period is before present date
    
                     Call enterdata                   ' create entries on Receipts & Payments
                End If
            End If
        End If
    
    ActiveCell.Offset(1, 0).Select 'evaluate next row
        
    Loop ' Until IsEmpty(ActiveCell) = True
    
    Exit Sub

End Sub

Private Sub enterdata()

ActiveWorkbook.Sheets("Receipts & Payments").Activate
Range("a10").Select

    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If

    Loop Until IsEmpty(ActiveCell) = True

    ActiveCell.Value = Sheets("CoA").ActiveCell.Value
    ActiveCell.Offset(0, 1) = Sheets("CoA").ActiveCell.Offset(2, 0).Value
    ActiveCell.Offset(0, 2) = Sheets("CoA").ActiveCell.Offset(3, 0).Value
    ActiveCell.Offset(0, 3) = Sheets("CoA").ActiveCellOffset(5, 0).Value
    ActiveCell.Offset(0, 4) = Sheets("CoA").ActiveCell.Offset(4, 0).Value
    ActiveCell.Offset(0, 10) = Sheets("CoA").ActiveCell.Offset(6, 0).Value
    
    ActiveWorkbook.Sheets("CoA").Activate
 
        If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then
                ActiveCell.Offset(0, 7).Value = ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value)
                ' if contract start plus one frequency period is before present date
        Else: ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value)
                                    
        End If
                


End Sub

Have I adequately explained the problem? I would appreciate any help on this.