Rahul87
New Member
- Joined
- Apr 7, 2023
- Messages
- 19
- Office Version
- 365
- 2021
- 2019
- 2016
- 2013
- 2011
- 2010
- 2007
- 2003 or older
- Platform
- Windows
Dear Experts,
Need your help in achieving on task for automate the calculation. I have an excel work book with two sheets, in which there is one calculation sheet naming as "calculation" and another is database sheet naming as "lbp". I am trying to achieve one task so that whenever a user update the lbp sheet which is a database to keep a record and then user navigate to calculation and click on update button, then it automatically fetch out the data from lbp sheet and calculate the data and provide the data on calculation sheet. The code checks for the previous month data and then just after leaving 2 rows it update the data below the previous month data along with previous month data as per the currencies but for the new month, which you can see how the calculation I am doing manually. I am not so expert in VBA, but I tried somewhat to achieve the task but it is throwing some error and somehow the calculation is also not going on for all months as how I want to do which you can refer the images on how currency and data are coming to the next month and year and so on, apart from it formatting is also challenging for me. So, please help me out in achieving the task. For better understanding you can refer the below images and code for example on what I am trying to achieve. Any help will be highly appreciated.
Below is the LBP sheet where user use to update the data on monthly basis.
Below is the calculation sheet where user needs to update the data on monthly basis by pressing the update button and clear button is used to clear all the data.
Below is the code, through which I am trying to achieve the task. Some what I am able to achieve, but still there is serial number issue, proper calculation of data issue, and formatting is not happening.
Need your help in achieving on task for automate the calculation. I have an excel work book with two sheets, in which there is one calculation sheet naming as "calculation" and another is database sheet naming as "lbp". I am trying to achieve one task so that whenever a user update the lbp sheet which is a database to keep a record and then user navigate to calculation and click on update button, then it automatically fetch out the data from lbp sheet and calculate the data and provide the data on calculation sheet. The code checks for the previous month data and then just after leaving 2 rows it update the data below the previous month data along with previous month data as per the currencies but for the new month, which you can see how the calculation I am doing manually. I am not so expert in VBA, but I tried somewhat to achieve the task but it is throwing some error and somehow the calculation is also not going on for all months as how I want to do which you can refer the images on how currency and data are coming to the next month and year and so on, apart from it formatting is also challenging for me. So, please help me out in achieving the task. For better understanding you can refer the below images and code for example on what I am trying to achieve. Any help will be highly appreciated.
Below is the LBP sheet where user use to update the data on monthly basis.
Below is the calculation sheet where user needs to update the data on monthly basis by pressing the update button and clear button is used to clear all the data.
Below is the code, through which I am trying to achieve the task. Some what I am able to achieve, but still there is serial number issue, proper calculation of data issue, and formatting is not happening.
VBA Code:
Sub UpdateCalculationSheet()
Dim wsLBP As Worksheet
Dim wsCalc As Worksheet
Dim lastRowLBP As Long
Dim lastRowCalc As Long
Dim i As Long
Dim feePercent As Double
Dim startDate As Date
Dim endDate As Date
Dim daysDiff As Long
Dim ccssFee As Double
Dim monthName As String
Dim yearValue As Integer
Dim currencyCode As String
Dim currencyList As Variant
Dim monthList As Variant
Dim amountFormula As String
Dim found As Boolean
Dim prevMonthData As Collection
Dim prevMonthBorrower As String
Dim prevMonthAmount As Double
Dim prevMonth As String
Dim prevYear As Integer
' Prompt user for month and year
monthList = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec")
monthName = Application.InputBox("Select the month (e.g., Jan, Feb, etc.):", Type:=2, Default:=monthList(0))
yearValue = InputBox("Enter the year (e.g., 2024):")
' Prompt user for currency code with dropdown list
currencyList = Array("TAK", "INR")
currencyCode = Application.InputBox("Select the currency code (TAK or INR):", Type:=2, Default:=currencyList(0))
' Set the worksheets
Set wsLBP = ThisWorkbook.Sheets("lbp")
Set wsCalc = ThisWorkbook.Sheets("calculation")
' Find the last row in the LBP sheet
lastRowLBP = wsLBP.Cells(wsLBP.Rows.Count, "A").End(xlUp).Row
' Find the last row in the Calculation sheet
lastRowCalc = wsCalc.Cells(wsCalc.Rows.Count, "A").End(xlUp).Row
If lastRowCalc > 1 Then
lastRowCalc = lastRowCalc + 4
End If
' Set the header
wsCalc.Cells(lastRowCalc, 1).Value = "CLIENT COVERAGE SUPPORT SERVICE (CCSS) FEE FOR THE MONTH OF " & UCase(monthName) & " " & yearValue & " - NDC BRANCH"
wsCalc.Range("A" & lastRowCalc & ":J" & lastRowCalc).Merge
wsCalc.Cells(lastRowCalc + 1, 1).Value = "Sr.No"
wsCalc.Cells(lastRowCalc + 1, 2).Value = "GCIF"
wsCalc.Cells(lastRowCalc + 1, 3).Value = "Name of Customer"
wsCalc.Cells(lastRowCalc + 1, 4).Value = "Date"
wsCalc.Cells(lastRowCalc + 1, 5).Value = "Currency"
wsCalc.Cells(lastRowCalc + 1, 6).Value = "Balance"
wsCalc.Cells(lastRowCalc + 1, 7).Value = "No. of days"
wsCalc.Cells(lastRowCalc + 1, 8).Value = "Fee %"
wsCalc.Cells(lastRowCalc + 1, 9).Value = "CCSS Fee"
wsCalc.Cells(lastRowCalc + 1, 10).Value = "Total CCSS Fee"
wsCalc.Cells(lastRowCalc + 2, 1).Value = "Foreign Currency Loans - " & currencyCode
wsCalc.Range("A" & lastRowCalc + 2 & ":J" & lastRowCalc + 2).Merge
' Format the header
With wsCalc.Range("A" & lastRowCalc & ":J" & lastRowCalc)
.Interior.Color = RGB(255, 165, 0) ' Orange background
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
With wsCalc.Range("A" & lastRowCalc + 1 & ":J" & lastRowCalc + 1)
.Interior.Color = RGB(230, 230, 255) ' Whitish purple background
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
With wsCalc.Range("A" & lastRowCalc + 2 & ":J" & lastRowCalc + 2)
.Interior.Color = RGB(204, 255, 204) ' Whitish green background
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
' Initialize the last row in the Calculation sheet
lastRowCalc = lastRowCalc + 3
amountFormula = "=SUM("
' Initialize collection for previous month data
Set prevMonthData = New Collection
' Determine the previous month and year
If monthName = "Jan" Then
prevMonth = "Dec"
prevYear = yearValue - 1
Else
prevMonth = monthList(Application.Match(monthName, monthList, 0) - 1)
prevYear = yearValue
End If
' Loop through the LBP sheet and copy data to the Calculation sheet
found = False
For i = 2 To lastRowLBP
' Check if the row matches the selected currency
If wsLBP.Cells(i, 5).Value = currencyCode Then
' Check if the execution date is within the selected month and year
If Month(wsLBP.Cells(i, 4).Value) = Month(DateValue("1 " & monthName)) And Year(wsLBP.Cells(i, 4).Value) = yearValue Then
' Copy data to the Calculation sheet
wsCalc.Cells(lastRowCalc, 1).Value = wsLBP.Cells(i, 1).Value ' Sr. No
wsCalc.Cells(lastRowCalc, 3).Value = wsLBP.Cells(i, 2).Value ' Borrower
wsCalc.Cells(lastRowCalc, 4).Value = wsLBP.Cells(i, 4).Value ' Execution Date
wsCalc.Cells(lastRowCalc + 1, 4).Value = DateSerial(yearValue, Month(DateValue("1 " & monthName)) + 1, 0) ' Last date of the month
wsCalc.Cells(lastRowCalc, 5).Value = wsLBP.Cells(i, 5).Value ' CURR
wsCalc.Cells(lastRowCalc, 6).Value = wsLBP.Cells(i, 6).Value ' Amount
wsCalc.Cells(lastRowCalc + 1, 6).Value = wsCalc.Cells(lastRowCalc, 6).Value ' Amount
wsCalc.Cells(lastRowCalc + 1, 7).Value = wsCalc.Cells(lastRowCalc + 1, 4).Value - wsCalc.Cells(lastRowCalc, 4).Value + 1 ' No. of days
wsCalc.Cells(lastRowCalc + 1, 8).Value = "0.125%" ' Fee %
wsCalc.Cells(lastRowCalc + 1, 9).Formula = "=ROUND(F" & lastRowCalc & "*H" & lastRowCalc + 1 & "*G" & lastRowCalc + 1 & "/360, 2)" ' CCSS Fee
wsCalc.Cells(lastRowCalc + 1, 10).Formula = "=I" & lastRowCalc + 1 ' Copy CCSS Fee to Total CCSS Fee
' Update the amount formula
If amountFormula = "=SUM(" Then
amountFormula = amountFormula & "F" & lastRowCalc
Else
amountFormula = amountFormula & "+F" & lastRowCalc
End If
' Update the last row in the Calculation sheet
lastRowCalc = lastRowCalc + 2
found = True
End If
End If
Next i
' If no matching data found, stop the code
If Not found Then
MsgBox "No matching data found for the selected month, year, and currency."
Exit Sub
End If
' Close the amount formula
amountFormula = amountFormula & ")"
' Calculate totals
wsCalc.Cells(lastRowCalc, 6).Formula = amountFormula
wsCalc.Cells(lastRowCalc, 10).Formula = "=SUM(J5:J" & lastRowCalc - 1 & ")"
' Format the data range
With wsCalc.Range("A4:J" & lastRowCalc)
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' Format the total calculation row
With wsCalc.Range("A" & lastRowCalc & ":J" & lastRowCalc)
.Font.Bold = True
.Interior.Color = RGB(255, 255, 153) ' Yellowish background
End With
End Sub
