The attached spreadsheet is now current and the previous one should be discarded. The following code matches the attached spreadsheet.
I have also been getting an intermittent error when the "End Function" statement in the code is ignored and a UDF {PrevSheet()} in a user add-in gets called. This results in an infinite loop which can only be terminated using Task Manager.
NB: Having checked the file uploaded I see that the UDF in the add-in did not travelled with it. I have therefore entered the date manually.
All I want to do is call a user defined function from a cell that does the following:
1) Looks in the previous month for the receipt.
2) Gets the day the receipt was received.
3) Adds 28 days to that day then subtracts the number of days in the previous month to get the day the receipt will be received in the current month.
4) Returns the result and displays it in the cell.
5) From this the date of the receipt in the current month is obtained.
I use the day in a separate column as it is easier to manipulate entries when adjusting and sorting entries. It is also less likely to screw up the conditional formatting used in the main spreadsheet.
It seems to me that the problem lies in how to return the value using the function.
I would appreciate it if someone would be kind enough to review my code and method of implementation give me some idea of where it is going wrong.
Option Explicit
Function FindReceiptDate() As Integer
On Error GoTo ErrorHandler
'This function sets up the entries for the receipts on each worksheet by:
'1) Checking for five Fridays in the active worksheet.
'2) Checking for the presence of a receipt in the active worksheet.
'3) If the worksheet is Apr then uses a seed date obtained manually from the last receipt from the workbook for the previous year (Mar).
'4) For subsequent worksheets it finds the date (day only as an integer) of the (last) receipt for the previous month.
'5) It then adds 28 days to obtain the receipt date for the current worksheet.
'6) If the date is less than 28 days before the end of the month it finds the date of a second receipt for the current month. commented out for the time being
'7) It finally populates the rest of the record. Not yey implemented
'A future development may be the automatic population of receipts on every sheet.
Const Receipt As String = "Receipt"
Dim CurrSheetNumber As Integer
Dim PrevSheetNumber As Integer
Dim CurrReceiptDate As Integer
Dim PrevReceiptDate As Integer
Dim SecondReceiptDate As Integer
Dim CurrDays As Integer
Dim PrevDays As Integer
CurrSheetNumber = ActiveSheet.Index
PrevSheetNumber = ActiveSheet.Index - 1
PrevDays = Day(Application.WorksheetFunction.EoMonth(Range("$B$4"), -1)) 'Days in previous month
CurrDays = Day(Application.WorksheetFunction.EoMonth(Range("$B$4"), 0)) 'Days in current month
'1) Find the date of the receipt for the current month based on the receipt date of the previous month (+28 days).
'2) Check to see if there are two payment in the current month.
If PrevSheetNumber <> 0 Then
Worksheets(PrevSheetNumber).Select
Range("F5:F49").Find(Receipt).Select
PrevReceiptDate = Cells(ActiveCell.Row, 3)
CurrReceiptDate = PrevReceiptDate + 28 - PrevDays
Worksheets(CurrSheetNumber).Select
' MsgBox "Receipt date this month = " & CurrReceiptDate
' If CurrReceiptDate + 28 <= CurrDays Then
' SecondReceiptDate = CurrReceiptDate + 28
' MsgBox SecondReceiptDate
' End If
Else: MsgBox "Enter the date for April manually"
GoTo Finish
End If
'FindReceiptDate = CurrReceiptDate
'ActiveCell = FindReceiptDate
ActiveCell = CurrReceiptDate
MsgBox "The Receipt Day for this month is " & CurrReceiptDate
MsgBox "The FindReceiptDate Day for this month is " & FindReceiptDate
GoTo Finish
ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
Finish:
End Function
Bookmarks