SOLVED

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

Iron Contributor

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.

 

Capture.JPG

 

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!

5 Replies

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

 

Really sorry to bother you.. 

best response confirmed by hrh_dash (Iron Contributor)
Solution

@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

Hi @Hans Vogelaar , 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..

 

 

@hrh_dash 

Using resize allows us to set the value of all cells in one step. That is much, much faster than doing it in a loop.

1 best response

Accepted Solutions
best response confirmed by hrh_dash (Iron Contributor)
Solution

@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

View solution in original post