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