Is your code running too slowly?
Does your workbook or database have a bunch of duplicate pieces of data?
Have a look at this article to learn the best ways to set up your projects.
It will save both time and effort in the long run!
Dave
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 ;
and this is the revised code for the Receipts & Payments (sheet 9) change event![]()
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
Have I adequately explained the problem? I would appreciate any help on this.![]()
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
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks