Dynamic macro to calculate the monthly receipts based on variables and nth number of months

How can i create a dynamic macro which could calculate the monthly receipts based on the highlighted in yellow variables?

Those that are highlighted in orange are supposed to populate the values by having contractbid/contractterm.

This is my code so far:

Dim amortisecollection As String
Dim contractbid As Range
Dim contractterm As Range
Dim period As Range
Dim lastRowReceipts As Long

amortisecollection = InputBox("Are we billing the customer on a monthly basis? Enter Y or N")

If amortisecollection = "Y" Then

With ws.Cells
Set contractbid = .Find(What:="Contract Bid (incl GST)", After:=ActiveCell, LookIn:=xlValues _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)
        
Set contractterm = .Find(What:="Contact Term (months)", After:=ActiveCell, LookIn:=xlValues _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)
   
Set period = .Find(What:="Period", After:=ActiveCell, LookIn:=xlValues _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)
        

lastRowReceipts = Cells(Rows.Count, "A").End(xlUp).row

Range("B12:B" & lastRowReceipts) = contractbid.Offset(0, 1) / contractterm.Offset(0, 1)

End With

        
Else
MsgBox ("Please key in the receipts and payments manually.")
Exit Sub

End If

Appreciate and thanks for the help in advance!

excel

Formulas and Functions

Does this work for you?

    Dim amortisecollection As String
    Dim contractbid As Range
    Dim contractterm As Range
    Dim period As Range
    Dim bidamount As Double
    Dim term As Long

    amortisecollection = InputBox("Are we billing the customer on a monthly basis? Enter Y or N")
    If amortisecollection = "Y" Then
        With ws.Cells
            Set contractbid = .Find(What:="Contract Bid (incl GST)", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            bidamount = contractbid.Offset(0, 1).Value
            Set contractterm = .Find(What:="Contact Term (months)", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            term = contractterm.Offset(0, 1).Value
            Set period = .Find(What:="Period", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            period.Offset(1).Resize(1000).ClearContents
            period.Offset(1).Resize(term).Value = bidamount / term
        End With
    Else
        MsgBox "Please key in the receipts and payments manually."
        Exit Sub
    End If

5 Replies

hrh_dash

Iron Contributor

Jul 25, 2022

Hi HansVogelaar , sorry to bother you, would need your advice on this. I am this close to complete this project..

Really sorry to bother you..

HansVogelaar

MVP

Jul 25, 2022

hrh_dash

Does this work for you?

    Dim amortisecollection As String
    Dim contractbid As Range
    Dim contractterm As Range
    Dim period As Range
    Dim bidamount As Double
    Dim term As Long

    amortisecollection = InputBox("Are we billing the customer on a monthly basis? Enter Y or N")
    If amortisecollection = "Y" Then
        With ws.Cells
            Set contractbid = .Find(What:="Contract Bid (incl GST)", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            bidamount = contractbid.Offset(0, 1).Value
            Set contractterm = .Find(What:="Contact Term (months)", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            term = contractterm.Offset(0, 1).Value
            Set period = .Find(What:="Period", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False)
            period.Offset(1).Resize(1000).ClearContents
            period.Offset(1).Resize(term).Value = bidamount / term
        End With
    Else
        MsgBox "Please key in the receipts and payments manually."
        Exit Sub
    End If

hrh_dash
Iron Contributor
Jul 26, 2022
Hi HansVogelaar , it works. I forgotten to dim ws as Worksheet and set ws as Sheet1. Thanks and appreciate the assist!

Would you be able to share why did you use the resize function? I thought a for loop would be able to resolve the issue..

Forum Discussion

Dynamic macro to calculate the monthly receipts based on variables and nth number of months

5 Replies

Resources