Sub CheckPaySchSO()
'
' Macro recorded 20/10/2009 by Philip Sharp
Dim intLSORow As Integer 'Last cell in Standing Orders table
Dim CellAddress As String
Dim Today As Date
Dim a As Integer
Today = Date
intLSORow = Sheets("CoA").Cells(47, "I").End(xlDown).Row
Sheets("CoA").Activate
'Do While ActiveCell.Value <> ""
For a = 47 To intLSORow
If Sheets("CoA").Cells(a, "I").Value < Today Then
'If ActiveCell.Value < Today Then ' checks to see if contract date is before the present date - if yes go to next evaluation
If Sheets("CoA").Cells(a, "P").Value = "" Then
'If ActiveCell.Offset(0, 7).Value = "" Then ' if there is no previous accounting entry date then
If Cells(a, "I").Value + Sheets("CoA").Cells(a, "J").Value < Today Then
'If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then ' if contract start plus one frequency period is before present date
'CellAddress = Sheets("CoA").Cells(a, "I").Address
Call enterdata(a) ' 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
If Sheets("CoA").Cells(a, "P").Value + Sheets("CoA").Cells(a, "J").Value < Today Then
'CellAddress = ActiveCell.Address
Call enterdata(a) ' create entries on Receipts & Payments
End If
End If
End If
Next a
End Sub
Private Sub enterdata(intRowNum As Integer)
Dim CellAddress As String
Dim Today As Date
Dim intNRPRow As Integer 'Next row in Receipts and Payments Table.
Today = Date
intNRPRow = Sheets("Receipts & Payments").Cells(10, "A").End(xlDown).Row + 1
With Sheets("Receipts & Payments")
.Cells(intNRPRow, 1).Value = Sheets("CoA").Cells(intRowNum, "I").Value
.Cells(intNRPRow, 2).Value = Sheets("CoA").Cells(intRowNum, "K").Value
.Cells(intNRPRow, 3).Value = Sheets("CoA").Cells(intRowNum, "L").Value
.Cells(intNRPRow, 4).Value = Sheets("CoA").Cells(intRowNum, "N").Value
.Cells(intNRPRow, 5).Value = Sheets("CoA").Cells(intRowNum, "M").Value
.Cells(intNRPRow, 11).Value = Sheets("CoA").Cells(intRowNum, "O").Value
End With
'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").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
'
' ActiveWorkbook.Sheets("CoA").Activate
' Range("I47").Select
'If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then
If Sheets("CoA").Cells(intRowNum, "I").Value + Sheets("CoA").Cells(intRowNum, "J").Value < Today Then
'ActiveCell.Offset(0, 7).Value = ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value)
Sheets("CoA").Cells(intRowNum, "P").Value = Sheets("CoA").Cells(intRowNum, "I").Value + Sheets("CoA").Cells(intRowNum, "J").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)
Else: Sheets("CoA").Cells(intRowNum, "P").Value = Sheets("CoA").Cells(intRowNum, "P") + Sheets("CoA").Cells(intRowNum, "J").Value
End If
End Sub
Bookmarks