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

I am getting myself in a knot here.
On sheet "CoA" i have at table of periodic payments that is created via an input form and what I want to do is have accounting entries automatically generated in my cask book based on dates.

The code for the input form is as follows;

Private Sub CmdBtnClear_Click()
    Call Userform_Initialize
End Sub

Private Sub CmdBtnCancel_Click()
    Unload Me
End Sub

Private Sub CmdBtnOK_Click()

Dim Today
Today = Now

If Me.tbxTo.Value = "" Then
        MsgBox "Please enter Customer / Supplier name.", vbExclamation, "Cash / Bank Transactions - Who?!"
        Me.tbxAmount.SetFocus
        Exit Sub
    End If
If Me.tbxDesc.Value = "" Then
        MsgBox "Please enter a short description.", vbExclamation, "Cash / Bank Transactions - What?"
        Me.tbxDesc.SetFocus
        Exit Sub
    End If
If Me.tbxDate.Value = "" Then
        MsgBox "Please enter a Date.", vbExclamation, "When does the standing order start."
        Me.tbxDate.SetFocus
        Exit Sub
    End If
If Me.tbxAmount.Value = "" Then
        MsgBox "Please enter an Amount.", vbExclamation, "Cash / Bank Transactions - O what a dill!"
        Me.tbxAmount.SetFocus
        Exit Sub
    End If
If Me.cbxFreq.Value = "" Then
        MsgBox "Enter the frequency of payments.", vbExclamation, "Cash / Bank Transactions - oops"
        Me.cbxAccount.SetFocus
        Exit Sub
    End If
If Me.cbxAccount.Value = "" Then
        MsgBox "Please select an Account from the drop down list or insert the account number.", vbExclamation, "Cash / Bank Transactions - oops"
        Me.cbxAccount.SetFocus
        Exit Sub
    End If

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

Private Sub Userform_Initialize()

    Dim rList  As Range

    '//Define the list and where it's obtained from (Columns A, & B in this example)
    With Worksheets("CoA")
        Set rList = .Range(.Cells(15, 1), .Cells(.Rows.Count, 2).End(xlUp))

    End With

    With Me
        
        With cbxAccount
            .ColumnCount = 2
            .ColumnWidths = 25
            .Width = 220
            .Height = 20
            .List = rList.Value
            .ListRows = 25
        End With
        
        With cbxFreq
            .AddItem "1"
            .AddItem "2"
            .AddItem "3"
            .AddItem "4"
            .AddItem "5"
            .AddItem "6"
            .AddItem "7"
            .AddItem "8"
            .AddItem "9"
            .AddItem "10"
            .AddItem "11"
            .AddItem "12"
            .ListRows = 12
        End With
    
            ' sets the other fields to zero
    
'    tbxDate.Value = ""
    cbxFreq.Value = ""
    tbxTo.Value = ""
    tbxDesc.Value = ""
    tbxRef.Value = ""
    cbxAccount.Value = ""
    tbxAmount.Value = ""
    tbxTo.SetFocus



End With

End Sub

The table entries work fine but the entries on sheet "Receipts & Payments" don't get made. It seems I am not using the date logic properly.

Then I have problems getting the change event / date based entries to work.

I think the logic is evident from the code and notes;

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Sheets("CoA").Select
    Range("I47").Select

    Do While ActiveCell <> ""
        
        If ActiveCell.Value < Now 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) < Now 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) < Now 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) < Now 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

Can anyone see where I am going wrong? Please?

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.

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.

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.

I can't use a fixed reference because the module that precedes is looping down the list checking date criteria. When it finds a row that meet the criteria some of the data is put in the second sheet, and so on.

I did as you suggested and I am still getting a run-time error '1004', 'Application-defined or object-defined error' on the line

 ActiveCell.Value = Sheets("CoA").Range(CellAddress).Value

Although the code fails at this point the actual date does get pasted to the second sheet: but that is as far as it goes. Any other ideas?

Yes, I changed them as follows;

    ActiveCell.Value = Sheets("CoA").Range(CellAddress).Value
    ActiveCell.Offset(0, 1) = Sheets("CoA").Range(CellAddress).Offset(0, 2).Value
    ActiveCell.Offset(0, 2) = Sheets("CoA").Range(CellAddress).Offset(0, 3).Value
    ActiveCell.Offset(0, 3) = Sheets("CoA").Range(CellAddress)(0, 5).Value
    ActiveCell.Offset(0, 4) = Sheets("CoA").Range(CellAddress).Offset(0, 4).Value
    ActiveCell.Offset(0, 10) = Sheets("CoA").Range(CellAddress).Offset(0, 6).Value

Thanks for taking the time to look at this by the way.

Ok here is a chopped down version of the workbook.

I have changed the sheet event to 'calculate' and the first part now seems to work when payments are set up but when it comes to the the sheet 9 update, the code it gets stuck.