LinkBack URL
About LinkBacks
upod 
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;
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.
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
Then I have problems getting the change event / date based entries to work.
I think the logic is evident from the code and notes;
Can anyone see where I am going wrong? Please?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
Register To Reply
Bookmarks