Ok, I see what the problem is. Give me a bit to fix it, I'm pretty busy with my real job today.
Ok, I see what the problem is. Give me a bit to fix it, I'm pretty busy with my real job today.
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
Ok, I rewrote your code. Here are a couple of issues:
1) You don't need to select things. Look closely at how I reworked all the "Select" code to make it more efficient. It will run much faster this way.
2) Your Frequency select between months cells don't work. The Month() function tells you what month the date you put in is in. For example, Month(Date) = 10 (October is the tenth month). Dates are stored as integers in excel. Since you put 1 and 3 in those cells, you are actually looking at 1/1/1900 and 1/3/1900. If you want to add a month, put 30 in those cells and just add the cell value instead of using the month code.
3) The reason it was giving you this last error was the scope of the variable was local. To make it work, above both modules define it as public. For example: Public yourvariable as String.
Go through this code and see the changes carefully. I put the revised code near the commented out lines of your code so you could see how they correspond. Then after, go ahead and delete out your code. If it is then not working properly, let me know and we'll tweak some more.
![]()
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
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks