VBA Code:
Option Explicit
Public strDailyAverageVoluePath As String, strVolume_ReportingFilePath As String
Public strTermLoanFilePath As String, strIBG_FilePath As String
Public sEnddate As String
Dim wbSource As New Workbook
Dim wbDestination As New Workbook
Dim strRange As String
Dim wsSource As New Worksheet
Dim wsDestination As New Worksheet
Dim bolStatus As Boolean
Dim strSourceFilePath As String
Dim strDestinationFilePath As String
Dim intLastColDestFile As Integer
Dim strLastColDestFile As String
Dim strLastCol_TL As String
Dim intLastRowDestFile As Integer
Function ValidateFiles() As Boolean
Dim fso As New FileSystemObject
ValidateFiles = True
If Not fso.FolderExists(frmMain.TextBox1.Text) Then
MsgBox "Input folder is not exist"
ValidateFiles = False
Exit Function
End If
If Not fso.FolderExists(frmMain.TextBox2.Text) Then
MsgBox "Output folder is not exist"
ValidateFiles = False
Exit Function
End If
strDailyAverageVoluePath = frmMain.TextBox2.Text & "\Daily Average Volue_Apr 18 MTD_COPS.xlsx"
strVolume_ReportingFilePath = frmMain.TextBox1.Text & "\Volume_Reporting.xlsx"
strTermLoanFilePath = frmMain.TextBox1.Text & "\Term loan.xlsx"
strIBG_FilePath = frmMain.TextBox1.Text & "\IBG Daily Processed Volume.xlsx"
If Not fso.FileExists(strDailyAverageVoluePath) Then
MsgBox "Daily Average Volue file is not exist"
ValidateFiles = False
Exit Function
End If
If Not fso.FileExists(strVolume_ReportingFilePath) Then
MsgBox "Volume_Reporting.xlsx file is not exist"
ValidateFiles = False
Exit Function
End If
If Not fso.FileExists(strTermLoanFilePath) Then
MsgBox "Term loan.xlsx file is not exist"
ValidateFiles = False
Exit Function
End If
If Not fso.FileExists(strIBG_FilePath) Then
MsgBox "IBG Daily Processed Volume.xlsx file is not exist"
ValidateFiles = False
Exit Function
End If
End Function
Function FindText(wsSource As Worksheet, searchText As String) As String
'Result return in format as Row-Column-Address, For Ex: 3-8-$H$3
'Find text in worksheet
Dim oFound As Range
Dim oLookin As Range
Dim sLookFor As String
sLookFor = searchText
Set oLookin = wsSource.Cells
Set oFound = oLookin.Find(what:=sLookFor, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
Dim oAdjacent As Range
If Not oFound Is Nothing Then
FindText = oFound.Row & "-" & oFound.Column & "-" & wsSource.Cells(oFound.Row, oFound.Column).Address
End If
'Check by loop
Dim intLastColDestFile As Integer
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
Do While intLastColDestFile > 1
With wsSource
If .Cells(3, intLastColDestFile).Text = searchText Then
FindText = "3-" & intLastColDestFile & "-" & wsSource.Cells(3, intLastColDestFile).Address
Exit Do
End If
End With
intLastColDestFile = intLastColDestFile - 1
Loop
End Function
Public Function GetLastDayOfMonth(ByVal myDate As Date) As Date
GetLastDayOfMonth = DateSerial(Year(myDate), Month(myDate) + 1, 0)
End Function
Function WeekOfMonth(TestDate As Date) As Integer
WeekOfMonth = RoundUpVBA(Day(TestDate) / 7, 0)
End Function
Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double
If InputDbl >= 0 Then
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
Else
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
End If
End Function
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Function PrintSummaryAssetMonthFormat()
Dim intWeek As Integer
Dim LastColaddress As String
Dim FirstColaddress As String
Dim weekFormula As String
Dim monthlyTotalFormula As String
strSourceFilePath = ActiveWorkbook.Path
'Set wbDestination = Workbooks.Open(strSourceFilePath & "\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 2
wbDestination.Worksheets("Summary Asset").Columns(intLastColDestFile).Delete
wbDestination.Worksheets("Summary Asset").Columns(intLastColDestFile).Delete
wbDestination.Worksheets("Summary Asset").Columns(intLastColDestFile).Delete
wbDestination.Worksheets("Summary Asset").Columns(intLastColDestFile).Delete
wbDestination.Worksheets("Summary Asset").Columns(intLastColDestFile).Delete
Dim dtStartDateOfMonth As Date, dtEndDateOfMonth As Date
Dim curCol As Integer
dtStartDateOfMonth = DateSerial(Year(Date), Month(Date), 1)
dtEndDateOfMonth = GetLastDayOfMonth(Date)
curCol = intLastColDestFile
FirstColaddress = wbDestination.Worksheets("Summary Asset").Cells(2, curCol).Address
weekFormula = FirstColaddress
Do While dtStartDateOfMonth <= dtEndDateOfMonth
With wbDestination.Worksheets("Summary Asset")
.Cells(3, curCol) = Format(dtStartDateOfMonth, "dd-MMM-yy")
'.Cells(3, curCol).ColumnWidth = 10
.Cells(3, curCol).Interior.Color = RGB(5, 60, 109)
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(5, curCol).Font.Bold = False
.Cells(6, curCol).Font.Bold = False
.Cells(8, curCol).Font.Bold = False
.Cells(9, curCol).Font.Bold = False
.Cells(11, curCol).Font.Bold = False
.Cells(12, curCol).Font.Bold = False
.Cells(3, curCol).Font.Color = vbWhite
.Cells.Font.Size = 10.5
'.Cells.Font.Bold = True
' .Cells.Font.Name = "Mulish"
.Cells.HorizontalAlignment = xlCenter
.Cells.VerticalAlignment = xlCenter
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
.Cells(2, curCol).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Cells(2, curCol).Borders(xlInsideVertical).LineStyle = xlContinuous
' '.Cells.WrapText = False
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
'Check for weekend
If Format(dtStartDateOfMonth, "ddd") = "Sun" Then
intWeek = Round(Format(dtStartDateOfMonth, "dd") / 7) + 1
monthlyTotalFormula = monthlyTotalFormula + Split(weekFormula, "$")(1) + "5:" + Replace(.Cells(5, curCol).Address, "$", "") + ","
curCol = curCol + 1
.Cells(3, curCol) = Format(dtStartDateOfMonth, "MMM-yy") + " W" + Trim(Str(intWeek)) + " Total"
.Cells(3, curCol).Interior.Color = RGB(191, 191, 191)
.Cells.WrapText = True
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - W Total
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
' Onboarding - W Total
.Cells(5, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "5:" + Replace(.Cells(5, curCol - 1).Address, "$", "") + ")"
' Servicing - W Total
.Cells(6, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "6:" + Replace(.Cells(6, curCol - 1).Address, "$", "") + ")"
' COPS Domestic - W Total
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
' Term Loan - W Total
.Cells(8, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "8:" + Replace(.Cells(8, curCol - 1).Address, "$", "") + ")"
' Working Capital - W Total
.Cells(9, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "9:" + Replace(.Cells(9, curCol - 1).Address, "$", "") + ")"
' COPS IBG - W Total
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
' Corporate Trans - W Total
.Cells(11, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "11:" + Replace(.Cells(11, curCol - 1).Address, "$", "") + ")"
' Name Screening - W Total
.Cells(12, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "12:" + Replace(.Cells(12, curCol - 1).Address, "$", "") + ")"
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
curCol = curCol + 1
.Cells(3, curCol) = Format(dtStartDateOfMonth, "MMM-yy") + " W" + Trim(Str(intWeek)) + " Daily Average"
.Cells(3, curCol).Interior.Color = RGB(242, 242, 242)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - Daily Average
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
' Onboarding - Daily Average
.Cells(5, curCol) = "=" & Replace(.Cells(5, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(5, curCol - 1).Formula, "=SUM", "Count")
' Servicing - Daily Average
.Cells(6, curCol) = "=" & Replace(.Cells(6, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(6, curCol - 1).Formula, "=SUM", "Count")
' COPS Domestic - Daily Average
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
' Term Loan - Daily Average
Cells(8, curCol) = "=" & Replace(.Cells(8, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(8, curCol - 1).Formula, "=SUM", "Count")
' Working Capital - Daily Average
.Cells(9, curCol) = "=" & Replace(.Cells(9, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(9, curCol - 1).Formula, "=SUM", "Count")
' COPS IBG - Daily Average
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
' Corporate Trans - Daily Average
.Cells(11, curCol) = "=" & Replace(.Cells(11, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(11, curCol - 1).Formula, "=SUM", "Count")
' Name Screening - Daily Average
.Cells(12, curCol) = "=" & Replace(.Cells(12, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(12, curCol - 1).Formula, "=SUM", "Count")
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
weekFormula = .Cells(2, curCol + 1).Address
End If
'Check for last day of the month
If dtStartDateOfMonth = dtEndDateOfMonth Then
intWeek = Round(Format(dtStartDateOfMonth, "dd") / 7) + 1
monthlyTotalFormula = monthlyTotalFormula + Split(weekFormula, "$")(1) + "5:" + Replace(.Cells(5, curCol).Address, "$", "")
curCol = curCol + 1
.Cells(3, curCol) = Format(dtStartDateOfMonth, "MMM-yy") + " W" + Trim(Str(intWeek)) + " Total"
.Cells(3, curCol).Interior.Color = RGB(191, 191, 191)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - W Total
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
' Onboarding - W Total
.Cells(5, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "5:" + Replace(.Cells(5, curCol - 1).Address, "$", "") + ")"
' Servicing - W Total
.Cells(6, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "6:" + Replace(.Cells(6, curCol - 1).Address, "$", "") + ")"
' COPS Domestic - W Total
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
' Term Loan - W Total
.Cells(8, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "8:" + Replace(.Cells(8, curCol - 1).Address, "$", "") + ")"
' Working Capital - W Total
.Cells(9, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "9:" + Replace(.Cells(9, curCol - 1).Address, "$", "") + ")"
' COPS IBG - W Total
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
' Corporate Trans - W Total
.Cells(11, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "11:" + Replace(.Cells(11, curCol - 1).Address, "$", "") + ")"
' Name Screening - W Total
.Cells(12, curCol) = "=Sum(" + Split(weekFormula, "$")(1) + "12:" + Replace(.Cells(12, curCol - 1).Address, "$", "") + ")"
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
curCol = curCol + 1
.Cells(3, curCol) = Format(dtStartDateOfMonth, "MMM-yy") + " W" + Trim(Str(intWeek)) + " Daily Average"
.Cells(3, curCol).Interior.Color = RGB(242, 242, 242)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - Daily Average
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
' Onboarding - Daily Average
.Cells(5, curCol) = "=" & Replace(.Cells(5, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(5, curCol - 1).Formula, "=SUM", "Count")
'
' Servicing - Daily Average
.Cells(6, curCol) = "=" & Replace(.Cells(6, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(6, curCol - 1).Formula, "=SUM", "Count")
' COPS Domestic - Daily Average
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
' Term Loan - Daily Average
.Cells(8, curCol) = "=" & Replace(.Cells(8, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(8, curCol - 1).Formula, "=SUM", "Count")
' Working Capital - Daily Average
.Cells(9, curCol) = "=" & Replace(.Cells(9, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(9, curCol - 1).Formula, "=SUM", "Count")
' COPS IBG - Daily Average
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
' Corporate Trans - Daily Average
.Cells(11, curCol) = "=" & Replace(.Cells(11, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(11, curCol - 1).Formula, "=SUM", "Count")
' Name Screening - Daily Average
.Cells(12, curCol) = "=" & Replace(.Cells(12, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(12, curCol - 1).Formula, "=SUM", "Count")
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
curCol = curCol + 1
.Cells(3, curCol) = Format(dtStartDateOfMonth, "MMM-yy") + " Total"
.Cells(3, curCol).Interior.Color = RGB(191, 191, 191)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
.Cells(5, curCol) = "=Sum(" + monthlyTotalFormula + ")" 'Last Week Total - Onboarding
.Cells(6, curCol) = Replace("=Sum(" + monthlyTotalFormula + ")", 5, 6) 'Last Week Total - Servicing
.Cells(8, curCol) = Replace("=Sum(" + monthlyTotalFormula + ")", 5, 8) 'Last Week Total - Term Loan
.Cells(9, curCol) = Replace("=Sum(" + monthlyTotalFormula + ")", 5, 9) 'Last Week Total - Working Capital
.Cells(11, curCol) = Replace("=Sum(" + monthlyTotalFormula + ")", 5, 11) 'Last Week Total - Corporate Trans
.Cells(12, curCol) = Replace("=Sum(" + monthlyTotalFormula + ")", 5, 12) 'Last Week Total - Name Screening
' .Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
'
.Cells(4, curCol - 2).Copy .Cells(4, curCol) ' Month Total - LOPS
.Cells(7, curCol - 2).Copy .Cells(7, curCol) ' Month Total - COPS Domestic
.Cells(10, curCol - 2).Copy .Cells(10, curCol) ' Month Total - COPS IBG
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
'
curCol = curCol + 1
.Cells(3, curCol) = "Daily Average " + Format(dtStartDateOfMonth, "MMM-yyyy")
.Cells(3, curCol).Interior.Color = RGB(242, 242, 242)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - Daily Average
.Cells(4, curCol) = Replace("=Sum(" + .Cells(5, curCol).Address + ":" + .Cells(6, curCol).Address + ")", "$", "")
' Onboarding - Daily Average
.Cells(5, curCol) = "=" & Replace(.Cells(5, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(5, curCol - 1).Formula, "=SUM", "Count")
' Servicing - Daily Average
.Cells(6, curCol) = "=" & Replace(.Cells(6, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(6, curCol - 1).Formula, "=SUM", "Count")
' COPS Domestic - Daily Average
.Cells(7, curCol) = Replace("=Sum(" + .Cells(8, curCol).Address + ":" + .Cells(9, curCol).Address + ")", "$", "")
' Term Loan - Daily Average
.Cells(8, curCol) = "=" & Replace(.Cells(8, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(8, curCol - 1).Formula, "=SUM", "Count")
' Working Capital - Daily Average
.Cells(9, curCol) = "=" & Replace(.Cells(9, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(9, curCol - 1).Formula, "=SUM", "Count")
' COPS IBG - Daily Average
.Cells(10, curCol) = Replace("=Sum(" + .Cells(11, curCol).Address + ":" + .Cells(12, curCol).Address + ")", "$", "")
' Corporate Trans - Daily Average
.Cells(11, curCol) = "=" & Replace(.Cells(11, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(11, curCol - 1).Formula, "=SUM", "Count")
' Name Screening - Daily Average
.Cells(12, curCol) = "=" & Replace(.Cells(12, curCol - 1).Address, "$", "") & "/" & Replace(.Cells(12, curCol - 1).Formula, "=SUM", "Count")
.Cells(13, curCol) = Replace("=Sum(" + .Cells(4, curCol).Address + "," + .Cells(7, curCol).Address + "," + .Cells(10, curCol).Address + ")", "$", "")
curCol = curCol + 1
.Cells(3, curCol) = "Inc % " + Chr(34) + "T Day" + Chr(34) + " to Mar W1 & W2 Daily Average "
.Cells(3, curCol).Interior.Color = RGB(191, 191, 191)
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(13, curCol).Font.Color = vbWhite
.Cells.WrapText = True
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
' LOPS - Inc % "T Day"
.Cells(4, curCol) = "=AOJ4/((O4+X4)/2)-1"
' Onboarding - Inc % "T Day"
.Cells(5, curCol) = "=AOJ5/((O4+X4)/2)-1"
' Servicing - Inc % "T Day"
.Cells(6, curCol) = "=AOJ6/((O4+X4)/2)-1"
' COPS Domestic - Daily Average
.Cells(7, curCol) = "=APB7/((O4+X4)/2)-1"
' Term Loan - Daily Average
.Cells(8, curCol) = "=APB8/((O4+X4)/2)-1"
' Working Capital - Daily Average
.Cells(9, curCol) = "=APB9/((O4+X4)/2)-1"
' COPS IBG - Daily Average
.Cells(10, curCol) = "=APB10/((O4+X4)/2)-1"
' Corporate Trans - Daily Average
.Cells(11, curCol) = "=APB11/((O4+X4)/2)-1"
' Name Screening - Daily Average
.Cells(12, curCol) = "=APB12/((O4+X4)/2)-1"
.Cells(13, curCol) = "=APB13/((O4+X4)/2)-1 "
End If
End With
curCol = curCol + 1
dtStartDateOfMonth = dtStartDateOfMonth + 1
Loop
'Last . Column print start
curCol = curCol + 1
Dim strRange As String
With wbDestination.Worksheets("Summary Asset")
strRange = .Cells(2, curCol).Address & ":" + .Cells(13, curCol).Address
.Range(strRange).Value = "."
.Cells(3, curCol).Interior.Color = RGB(191, 191, 191)
.Cells(4, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(7, curCol).Interior.Color = RGB(217, 225, 242)
.Cells(10, curCol).Interior.Color = RGB(217, 225, 242)
.Cells.HorizontalAlignment = xlCenter
.Cells.VerticalAlignment = xlCenter
.Cells(13, curCol).Interior.Color = RGB(38, 38, 38)
.Cells(2, curCol).Interior.Color = RGB(5, 60, 109)
.Cells(2, curCol).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Cells(2, curCol).Borders(xlInsideVertical).LineStyle = xlContinuous
.Cells(3, curCol).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Cells(3, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(4, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(5, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(6, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(7, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(8, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(9, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(10, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(11, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(12, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(13, curCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Cells(13, curCol).Font.Color = vbWhite
LastColaddress = wbDestination.Worksheets("Summary Asset").Cells(2, curCol).Address
.Range("D2:" + LastColaddress).Interior.Color = RGB(5, 60, 109)
.Range("B3:" + LastColaddress).Borders(xlEdgeBottom).LineStyle = xlContinuous
' .Range("D3:" + LastColaddress).Borders(xlEdgeBottom).Weight = xlMedium
'wbDestination.Worksheets("Test").Range("B3:" + LastColaddress).BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.Range("D4:" + LastColaddress).Borders(xlInsideVertical).LineStyle = xlContinuous
.Range("B3:" + Split(LastColaddress, "$")(1) & "13").Borders.LineStyle = xlContinuous
.Range("B3:" + Split(LastColaddress, "$")(1) & "13").BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Range("B10:" + Split(LastColaddress, "$")(1) & "13").Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range("B2:" + Split(LastColaddress, "$")(1) & "12").EntireColumn.AutoFit
Dim lastRowRange As String
lastRowRange = Split(FirstColaddress, "$")(1) & "13" & ":" & Split(LastColaddress, "$")(1) & "13"
.Range(lastRowRange).Interior.Color = RGB(38, 38, 38)
.Range(lastRowRange).Font.Color = vbWhite
.Rows(3).AutoFit
End With
End Function
Function SummaryAsset()
Dim TLlastCol As Integer
Dim WCLastCol As Integer
Dim IBGlastCol As Integer
Dim LOPSlastcol As Integer
strSourceFilePath = ActiveWorkbook.Path
If FileInUse(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx") Then
MsgBox ("File 'Daily Average Volue_Apr 18 MTD_COPS.xlsx' is open. Please close it.")
Exit Function
End If
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
wbDestination.Worksheets("Summary Asset").Columns.EntireColumn.Hidden = False ' Unhide all columns
If Format(sEnddate, "dd") = 1 Then
Call PrintSummaryAssetMonthFormat(wbDestination)
End If
'Find text in worksheet
Dim strTextPosition As String
strTextPosition = FindText(wbDestination.Worksheets("Summary Asset"), Format(sEnddate, "d-MMM-yy")) '"3-Apr-22"
'wbDestination.Worksheets("Summary Asset").Cells(12, intLastColDestFile).Value = Format(sEnddate, "dd-MMM-yy")
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
Dim intCurrDateCol As Integer
intCurrDateCol = Split(strTextPosition, "-")(1) 'Get Column number
strLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(1, intCurrDateCol).Address
TLlastCol = wbDestination.Worksheets("TL").Cells(1, Columns.Count).End(xlToLeft).Columns
WCLastCol = wbDestination.Worksheets("WC").Cells(1, Columns.Count).End(xlToLeft).Column
IBGlastCol = wbDestination.Worksheets("IBG").Cells(1, Columns.Count).End(xlToLeft).Column
LOPSlastcol = wbDestination.Worksheets("LOPS").Cells(1, Columns.Count).End(xlToLeft).Column
wbDestination.Worksheets("Summary Asset").Cells(15, intCurrDateCol).Value = Format(sEnddate, "dd-MMM-yy")
wbDestination.Worksheets("Summary Asset").Cells(15, intCurrDateCol).Interior.Color = RGB(5, 60, 109)
wbDestination.Worksheets("Summary Asset").Cells(15, intCurrDateCol).Font.Color = vbWhite
wbDestination.Worksheets("Summary Asset").Cells(15, intCurrDateCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
wbDestination.Worksheets("Summary Asset").Cells(16, intCurrDateCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
wbDestination.Worksheets("Summary Asset").Cells(17, intCurrDateCol).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
With wbDestination.Worksheets("Summary Asset")
.Cells(5, intCurrDateCol) = wbDestination.Worksheets("LOPS").Cells(15, LOPSlastcol - 1)
.Cells(6, intCurrDateCol) = wbDestination.Worksheets("LOPS").Cells(16, LOPSlastcol - 1)
.Cells(8, intCurrDateCol) = wbDestination.Worksheets("TL").Cells(21, TLlastCol - 1)
.Cells(9, intCurrDateCol) = wbDestination.Worksheets("WC").Cells(38, WCLastCol - 1)
.Cells(11, intCurrDateCol) = wbDestination.Worksheets("IBG").Cells(107, IBGlastCol - 1)
.Cells(12, intCurrDateCol) = wbDestination.Worksheets("IBG").Cells(108, IBGlastCol - 1)
.Cells(16, intCurrDateCol) = wbDestination.Worksheets("WC").Cells(25, WCLastCol - 1)
.Cells(17, intCurrDateCol) = wbDestination.Worksheets("WC").Cells(26, WCLastCol - 1)
Dim strINCCalculation As String
strINCCalculation = "/((O4+X4)/2)-1"
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 2
'INC
' LOPS - Inc % "T Day"
.Cells(4, intLastColDestFile) = "=" + .Cells(4, intCurrDateCol).Address + "/((O4+X4)/2)-1"
' Onboarding - Inc % "T Day"
.Cells(5, intLastColDestFile) = "=" + .Cells(5, intCurrDateCol).Address + "/((O5+X5)/2)-1"
' Servicing - Inc % "T Day"
.Cells(6, intLastColDestFile) = "=" + .Cells(6, intCurrDateCol).Address + "/((O6+X6)/2)-1"
' COPS Domestic - Daily Average
.Cells(7, intLastColDestFile) = "=" + .Cells(7, intCurrDateCol).Address + "/((O7+X7)/2)-1"
' Term Loan - Daily Average
.Cells(8, intLastColDestFile) = "=" + .Cells(8, intCurrDateCol).Address + "/((O8+X8)/2)-1"
' Working Capital - Daily Average
.Cells(9, intLastColDestFile) = "=" + .Cells(9, intCurrDateCol).Address + "/((O9+X9)/2)-1"
' COPS IBG - Daily Average
.Cells(10, intLastColDestFile) = "=" + .Cells(10, intCurrDateCol).Address + "/((O10+X10)/2)-1"
' Corporate Trans - Daily Average
.Cells(11, intLastColDestFile) = "=" + .Cells(11, intCurrDateCol).Address + "/((O11+X11)/2)-1"
' Name Screening - Daily Average
.Cells(12, intLastColDestFile) = "=" + .Cells(12, intCurrDateCol).Address + "/((O12+X12)/2)-1"
.Cells(13, intLastColDestFile) = "=" + .Cells(13, intCurrDateCol).Address + "/((O13+X13)/2)-1"
.Range(.Cells(4, intLastColDestFile), .Cells(13, intLastColDestFile)).Style = "Percent"
End With
wbDestination.Save
wbDestination.Close
End Function
Function WC()
'Required Things
' 1. Sheet name will be as per current date, Ex. 31.12.2022
' 2. Destination File must have Column 'PRODUCTS' and Column 'Total' with formula
On Error GoTo Err:
strSourceFilePath = ActiveWorkbook.Path
Set wbSource = Workbooks.Open(strSourceFilePath & "\Source\Volume_Reporting.xlsx")
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
' Sheet name will be as per current date, Ex. 31.12.2022
Set wsSource = wbSource.Worksheets(Format(sEnddate, "dd.MM.yyyy"))
Set wsDestination = wbDestination.Worksheets("WC")
'Get Last Column
intLastColDestFile = wsDestination.Cells(1, Columns.Count).End(xlToLeft).Column
If Format(sEnddate, "dd") = 1 Then
bolStatus = DeleteCol(wsDestination, 4, intLastColDestFile - 1)
intLastColDestFile = wsDestination.Cells(3, Columns.Count).End(xlToLeft).Column
End If
strLastColDestFile = wsDestination.Cells(2, intLastColDestFile).Address
strLastColDestFile = Replace(strLastColDestFile, "$", "")
'Get Last Row
intLastRowDestFile = wsDestination.Cells(Rows.Count, intLastColDestFile).End(xlUp).Row
'Column 'Total' copy and paste to the next column
With wsDestination
.Range(.Cells(1, intLastColDestFile), _
.Cells(intLastRowDestFile, intLastColDestFile)).Copy .Range(.Cells(1, intLastColDestFile + 1), _
.Cells(intLastRowDestFile, intLastColDestFile + 1))
.Range(.Cells(1, intLastColDestFile), .Cells(intLastRowDestFile - 13, intLastColDestFile)) = ""
End With
'WC values copy paste
wsDestination.Cells(1, intLastColDestFile).Value = Format(sEnddate, "dd-MMM") 'Date Format DD-MMM, Ex. 01-Jan
wsSource.Range("I3:I34").Copy
wsDestination.Range(strLastColDestFile).PasteSpecial Paste:=xlPasteValues
If Format(sEnddate, "dd") = 1 Then
wsDestination.Columns(3).EntireColumn.Delete
End If
Call CalcTotal(wsDestination, 3, 37)
wbSource.Close
wbDestination.Save
wbDestination.Close
Exit Function
Err:
MsgBox "WC(): " & Err.Description
Resume Next
End Function
Function TermLoan()
'Required Things
' 1. Sheet Name 'TL'
' 2. Column 'Activity Name'
' 3. Column 'Total' with formula
On Error GoTo Err:
strSourceFilePath = ActiveWorkbook.Path
Set wbSource = Workbooks.Open(strSourceFilePath & "\Source\Term loan.xlsx")
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsDestination = wbDestination.Worksheets("TL")
'Get Last Column
intLastColDestFile = wsDestination.Cells(1, Columns.Count).End(xlToLeft).Column
If Format(sEnddate, "dd") = 1 Then
bolStatus = DeleteCol(wsDestination, 3, intLastColDestFile - 1)
intLastColDestFile = wsDestination.Cells(3, Columns.Count).End(xlToLeft).Column
End If
strLastColDestFile = wsDestination.Cells(2, intLastColDestFile).Address
strLastColDestFile = Replace(strLastColDestFile, "$", "")
' strLastCol_TL = To access column from WC()
strLastCol_TL = strLastColDestFile
'Get Last Row
intLastRowDestFile = wsDestination.Cells(Rows.Count, "A").End(xlUp).Row
'Column 'Total' copy and paste to the next column
With wsDestination
.Columns(intLastColDestFile).Copy .Columns(intLastColDestFile + 1)
End With
'TL values copy paste
wsDestination.Cells(1, intLastColDestFile).Value = Format(sEnddate, "dd-MMM") 'Date Format DD-MMM, Ex. 01-Jan
wsSource.Range("B2:B20").Copy wsDestination.Range(strLastColDestFile)
If Format(sEnddate, "dd") = 1 Then
wsDestination.Columns(2).EntireColumn.Delete
End If
Call CalcTotal(wsDestination, 2, 20)
wbSource.Close
wbDestination.Save
wbDestination.Close
Exit Function
Err:
MsgBox "TermLoan(): " & Err.Description
End Function
Function IBGDailyProcessedVolume()
strSourceFilePath = ActiveWorkbook.Path
Set wbSource = Workbooks.Open(strSourceFilePath & "\Source\IBG Daily Processed Volume.xlsx")
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
'Get Last Column
intLastColDestFile = wbDestination.Worksheets("IBG").Cells(1, Columns.Count).End(xlToLeft).Column
If Format(sEnddate, "dd") = 1 Then
bolStatus = DeleteCol(wbDestination.Worksheets("IBG"), 11, intLastColDestFile - 1)
intLastColDestFile = wbDestination.Worksheets("IBG").Cells(1, Columns.Count).End(xlToLeft).Column
End If
strLastColDestFile = wbDestination.Worksheets("IBG").Cells(2, intLastColDestFile).Address
strLastColDestFile = Replace(strLastColDestFile, "$", "")
'Get Last Row
intLastRowDestFile = wbDestination.Worksheets("IBG").Cells(Rows.Count, "D").End(xlUp).Row
'Column 'Total' copy and paste to the next column
With wbDestination.Worksheets("IBG")
.Range(.Cells(1, intLastColDestFile), .Cells(intLastRowDestFile, intLastColDestFile)).Copy .Range(.Cells(1, intLastColDestFile + 1), .Cells(intLastRowDestFile, intLastColDestFile + 1))
End With
'IBG values copy paste
wbDestination.Worksheets("IBG").Cells(1, intLastColDestFile).Value = Format(sEnddate, "dd-MMM") 'Date Format DD-MMM-YY, Ex. 01-Jan-22
'wbDestination.Worksheets("IBG").Columns("J:AX").AutoFit.AutoFit
wbSource.Worksheets(Format(sEnddate, "dd")) _
.Range("S2:S102").Copy
wbDestination.Worksheets("IBG") _
.Range(strLastColDestFile).PasteSpecial xlPasteValues
If Format(sEnddate, "dd") = 1 Then
wbDestination.Worksheets("IBG").Columns(10).EntireColumn.Delete
End If
Call CalcTotal(wbDestination.Worksheets("IBG"), 10, 102)
intLastColDestFile = wbDestination.Worksheets("IBG").Cells(1, Columns.Count).End(xlToLeft).Column
With wbDestination.Worksheets("IBG")
strRange = .Cells(107, intLastColDestFile - 1).Address
strRange = Split(strRange, "$")(1)
.Cells(107, intLastColDestFile - 1).Formula = Replace("=SUM(AN2:AN13,AN15:AN51,AN53:AN68,AN71:AN74,AN76:AN87,AN89:AN102)", "AN", strRange)
strRange = .Cells(108, intLastColDestFile - 1).Address
strRange = Split(strRange, "$")(1)
.Cells(108, intLastColDestFile - 1) = Replace("=SUM(AN14,AN52,AN69:AN70,AN75,AN88)", "AN", strRange)
'intLastRowDestFile = wbDestination.Worksheets("IBG").Cells(Rows.Count, "D").End(xlUp).Row
'
'
'Dim intEnd
'Do While intEndRow > 1
' .Cells(intEndRow, intLastCol).Formula = "=Sum(RC[-" & intLastCol - intStartCol & "]:RC" & intLastCol - 1 & ")"
' intEndRow = intEndRow - 1
'' Loop
End With
wbSource.Close
wbDestination.Save
wbDestination.Close
Exit Function
Err:
MsgBox "IBG(): " & Err.Descriptions
End Function
Function LOPS()
On Error GoTo Err:
Dim intLastColSrcFile As Integer
Dim strLastColSrcFile As Integer
Application.DisplayAlerts = False
Application.EnableEvents = False
strSourceFilePath = ActiveWorkbook.Path
Set wbSource = Workbooks.Open(strSourceFilePath & "\Source\Daily volume tracker_Chandan Sir.xlsx")
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
'Get Last Column
intLastColDestFile = wbDestination.Worksheets("LOPS").Cells(1, Columns.Count).End(xlToLeft).Column
If Format(sEnddate, "dd") = 1 Then
bolStatus = DeleteCol(wbDestination.Worksheets("LOPS"), 4, intLastColDestFile - 1)
intLastColDestFile = wbDestination.Worksheets("LOPS").Cells(1, Columns.Count).End(xlToLeft).Column
End If
strLastColDestFile = wbDestination.Worksheets("LOPS").Cells(2, intLastColDestFile).Address
strLastColDestFile = Replace(strLastColDestFile, "$", "")
'Get Last Row
intLastRowDestFile = wbDestination.Worksheets("LOPS").Cells(Rows.Count, "B").End(xlUp).Row
'Column 'Total' copy and paste to the next column
With wbDestination.Worksheets("LOPS")
' .Range(.Cells(1, intLastColDestFile), .Cells(intLastRowDestFile, intLastColDestFile)).Copy .Range(.Cells(1, intLastColDestFile + 1), .Cells(intLastRowDestFile, intLastColDestFile + 1))
'End With
.Columns(intLastColDestFile).Copy .Columns(intLastColDestFile + 1)
End With
'TL values copy paste
wbDestination.Worksheets("LOPS").Cells(1, intLastColDestFile).Value = Format(sEnddate, "dd-MMM-YY") 'Date Format DD-MMM, Ex. 01-Jan
intLastColSrcFile = wbSource.Worksheets("Retail Loans").Cells(3, Columns.Count).End(xlToLeft).Column
Dim CellText As String
Dim Date_DD As String
Date_DD = Format(sEnddate, "d")
If Right(Date_DD, 1) = 1 Then
Date_DD = Date_DD + "st"
ElseIf Right(Date_DD, 1) = 2 Then
Date_DD = Date_DD + "nd"
ElseIf Right(Date_DD, 1) = 3 Then
Date_DD = Date_DD + "rd"
Else
Date_DD = Date_DD + "th"
End If
Do While intLastColSrcFile > 0
CellText = Trim(wbSource.Worksheets("Retail Loans").Cells(3, intLastColSrcFile).Value)
If CellText = Date_DD Then
Exit Do
End If
intLastColSrcFile = intLastColSrcFile - 1
Loop
wbSource.Worksheets("Retail Loans").Cells(22, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(strLastColDestFile).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(24, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "3")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(25, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "4")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(26, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "5")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(27, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "6")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(28, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "7")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(29, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "8")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(58, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "9")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(59, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "10")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(60, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "11")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(84, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "12")).PasteSpecial xlPasteValues
wbSource.Worksheets("Retail Loans").Cells(85, intLastColSrcFile).Copy
wbDestination.Worksheets("LOPS").Range(Replace(strLastColDestFile, "2", "13")).PasteSpecial xlPasteValues
If Format(sEnddate, "dd") = 1 Then
wbDestination.Worksheets("LOPS").Columns(3).EntireColumn.Delete
End If
Call CalcTotal(wbDestination.Worksheets("LOPS"), 3, 13)
wbSource.Close
wbDestination.Save
wbDestination.Close
Exit Function
Err:
MsgBox "LOPS(): " & Err.Descriptions
Resume Next
End Function
Function SummaryAssetOld()
Dim TLlastCol As Integer
Dim WCLastCol As Integer
Dim IBGlastCol As Integer
strSourceFilePath = ActiveWorkbook.Path
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
intLastColDestFile = wbDestination.Worksheets("Summary Asset Old").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 5
strLastColDestFile = wbDestination.Worksheets("Summary Asset Old").Cells(3, intLastColDestFile).Address
If Format(sEnddate, "dd") = 1 Then
Dim lastrow As Integer
With wbDestination.Worksheets("Summary Asset Old")
lastrow = .Cells(Rows.Count, "C").End(xlUp).Row
strRange = .Cells(2, intLastColDestFile).Address
strRange = strRange + ":" + .Cells(lastrow, intLastColDestFile + 5).Address
.Range(strRange).Copy
.Cells(2, intLastColDestFile + 6).PasteSpecial Paste:=xlAll
.Cells(2, intLastColDestFile + 6).PasteSpecial Paste:=xlPasteFormats
strRange = .Cells(2, intLastColDestFile + 3).Address
strRange = strRange + ":" + .Cells(lastrow, intLastColDestFile + 5).Address
.Range(strRange).EntireColumn.Delete
intLastColDestFile = wbDestination.Worksheets("Summary Asset Old").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 5
strLastColDestFile = .Cells(3, intLastColDestFile).Address
wbDestination.Worksheets("Summary Asset Old").Range(strLastColDestFile).EntireColumn.Insert
End With
Else
intLastColDestFile = wbDestination.Worksheets("Summary Asset Old").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 5
strLastColDestFile = wbDestination.Worksheets("Summary Asset Old").Cells(3, intLastColDestFile).Address
wbDestination.Worksheets("Summary Asset Old").Range(strLastColDestFile).EntireColumn.Insert
End If
With wbDestination.Worksheets("Summary Asset Old")
.Columns(intLastColDestFile + 1).Copy .Columns(intLastColDestFile)
intLastColDestFile = intLastColDestFile + 1
End With
strLastColDestFile = Replace(strLastColDestFile, "$", "")
wbDestination.Worksheets("Summary Asset Old").Cells(3, intLastColDestFile).Value = Format(sEnddate, "dd-MMM-yy")
wbDestination.Worksheets("Summary Asset Old").Cells(13, intLastColDestFile).Value = Format(sEnddate, "dd-MMM-yy")
TLlastCol = wbDestination.Worksheets("TL").Cells(1, Columns.Count).End(xlToLeft).Column
WCLastCol = wbDestination.Worksheets("WC").Cells(1, Columns.Count).End(xlToLeft).Column
IBGlastCol = wbDestination.Worksheets("IBG").Cells(1, Columns.Count).End(xlToLeft).Column
With wbDestination
.Worksheets("Summary Asset Old").Cells(5, intLastColDestFile) = .Worksheets("TL").Cells(21, TLlastCol - 1)
.Worksheets("Summary Asset Old").Cells(6, intLastColDestFile) = .Worksheets("WC").Cells(45, WCLastCol - 1)
.Worksheets("Summary Asset Old").Cells(9, intLastColDestFile) = .Worksheets("IBG").Cells(104, IBGlastCol - 1)
.Worksheets("Summary Asset Old").Cells(7, intLastColDestFile) = .Worksheets("WC").Cells(46, WCLastCol - 1)
.Worksheets("Summary Asset Old").Cells(8, intLastColDestFile) = .Worksheets("WC").Cells(34, WCLastCol - 1) + .Worksheets("WC").Cells(35, WCLastCol - 1)
.Worksheets("Summary Asset Old").Cells(14, intLastColDestFile) = .Worksheets("WC").Cells(25, WCLastCol - 1)
.Worksheets("Summary Asset Old").Cells(15, intLastColDestFile) = .Worksheets("WC").Cells(26, WCLastCol - 1)
If Format(sEnddate, "dd") = 1 Then
Dim Summarysumm As Integer
intLastColDestFile = .Worksheets("Summary Asset Old").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 4
.Worksheets("Summary Asset Old").Cells(5, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(6, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(7, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(8, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(9, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(10, intLastColDestFile) = "=SUM(RC[-1])"
.Worksheets("Summary Asset Old").Cells(3, intLastColDestFile).Value = Format(sEnddate, "mmm-yy") + " Total"
.Worksheets("Summary Asset Old").Cells(3, intLastColDestFile + 1).Value = " Daily Average " + Format(sEnddate, "mmm-yy")
.Worksheets("Summary Asset Old").Columns(intLastColDestFile - 2).EntireColumn.Delete
Else
Summarysumm = Format(sEnddate, "dd")
.Worksheets("Summary Asset Old").Cells(5, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
.Worksheets("Summary Asset Old").Cells(6, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
.Worksheets("Summary Asset Old").Cells(7, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
.Worksheets("Summary Asset Old").Cells(8, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
.Worksheets("Summary Asset Old").Cells(9, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
.Worksheets("Summary Asset Old").Cells(10, intLastColDestFile + 1) = "=Sum(RC[-" & Summarysumm & "]:RC[-1])"
End If
'intLastColDestFile = .Worksheets("Summary Asset Old").Cells(3, Columns.Count).End(xlToLeft).Column
'intLastColDestFile = intLastColDestFile - 4
End With
'Check column of start date of the month - logic start
'Dim strColStartDt As String
'Dim intColStartDt As Integer
'intColStartDt = intLastColDestFile
'Do While intColStartDt > 1
' With wbDestination.Worksheets("Summary Asset Old")
' If .Cells(3, intColStartDt).Text = "1-" + Format(sEnddate, "mmm-yy") Then
' Exit Do
' End If
' End With
' intColStartDt = intColStartDt - 1
'Loop
''Check column of start date of the month - logic end
Dim strINCCalculation As String
Dim intCurrDateCol As Integer
With wbDestination.Worksheets("Summary Asset Old")
strINCCalculation = "/((N4+W4)/2)-1"
intLastColDestFile = .Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 2
'INC
' LOPS - Inc % "T Day"
.Cells(4, intLastColDestFile) = "=" + .Cells(4, intLastColDestFile - 3).Address + "/((N4+W4)/2)-1"
.Cells(5, intLastColDestFile) = "=" + .Cells(5, intLastColDestFile - 3).Address + "/((N4+W4)/2)-1"
.Cells(6, intLastColDestFile) = "=" + .Cells(6, intLastColDestFile - 3).Address + "/((N4+W4)/2)-1"
.Cells(9, intLastColDestFile) = "=" + .Cells(9, intLastColDestFile - 3).Address + "/((N4+W4)/2)-1"
.Cells(10, intLastColDestFile) = "=" + .Cells(10, intLastColDestFile - 3).Address + "/((N4+W4)/2)-1"
End With
wbDestination.Save
wbDestination.Close
MsgBox "Summary Asset Old process completed"
End Function
Function HideCol()
Dim arr(1000) As String
Dim TLlastCol As Integer
Dim WCLastCol As Integer
Dim IBGlastCol As Integer
strSourceFilePath = ActiveWorkbook.Path
If FileInUse(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx") Then
MsgBox ("File 'Daily Average Volue_Apr 18 MTD_COPS.xlsx' is open. Please close it.")
Exit Function
End If
Set wbDestination = Workbooks.Open(strSourceFilePath & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx")
intLastColDestFile = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
intLastColDestFile = intLastColDestFile - 2
Dim intCurRowToCheckDailyAvg As Long
Dim intColWithDailyAvg As Integer
intColWithDailyAvg = 0
intCurRowToCheckDailyAvg = 4
Do While intCurRowToCheckDailyAvg < intLastColDestFile
With wbDestination.Worksheets("Summary Asset")
If (Left(Trim(.Cells(3, intCurRowToCheckDailyAvg)), 13) = "Daily Average") Then
arr(intColWithDailyAvg) = Str(intCurRowToCheckDailyAvg)
intColWithDailyAvg = intColWithDailyAvg + 1
ElseIf .Cells(3, intCurRowToCheckDailyAvg).Text = Format(sEnddate, "dd-mmm-yy") Then
arr(intColWithDailyAvg) = Str(intCurRowToCheckDailyAvg)
intColWithDailyAvg = intColWithDailyAvg + 1
Else
.Columns(intCurRowToCheckDailyAvg).EntireColumn.Hidden = True
End If
If Trim(.Cells(3, intCurRowToCheckDailyAvg).Text) = "Daily Average " & Format(sEnddate, "MMM-yyyy") Then
.Columns(intCurRowToCheckDailyAvg).EntireColumn.Hidden = True
End If
End With
intCurRowToCheckDailyAvg = intCurRowToCheckDailyAvg + 1
Loop
wbDestination.Save
wbDestination.Close
End Function
Function CalcTotal(WS As Worksheet, intStartCol As Integer, intEndRow As Integer) As Boolean
'Test Total Column STart
Dim intLastRow As Integer
Dim intLastCol As Integer
On Error GoTo Err
With WS
' intLastRow = .Cells(Rows.Count, intStartCol - 1).End(xlUp).Row
' intLastRow = intLastRow - 1
intLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, intLastCol) = "Total"
Do While intEndRow > 1
.Cells(intEndRow, intLastCol).Formula = "=Sum(RC[-" & intLastCol - intStartCol & "]:RC" & intLastCol - 1 & ")"
intEndRow = intEndRow - 1
Loop
End With
'TEst Total Column End
CalcTotal = True
Exit Function
Err:
CalcTotal = False
MsgBox "CalcTotal() - " & Err.Description
End Function
Function DeleteCol(wsDestination As Worksheet, startCol As Integer, endCol As Integer) As Boolean
On Error GoTo Err:
DeleteCol = False
Dim strStartCol As String, strEndCol As String
With wsDestination
strStartCol = Split(.Cells(, startCol).Address, "$")(1)
strEndCol = Split(.Cells(, endCol).Address, "$")(1)
.Columns(strStartCol & ":" & strEndCol).EntireColumn.Delete
End With
DeleteCol = True
Exit Function
Err:
DeleteCol = False
MsgBox "DeleteCol(): " & Err.Description
End Function
========================
Sub RobotStart()
If ValidateFiles = True Then
Call sbSetMonthAndYear
Call TermLoan
Call WC
Call IBGDailyProcessedVolume
Call LOPS
Call SummaryAssetOld
Call SummaryAsset
Call HideCol
Call SendE_Mail
End If
End Sub
Public Function FileInUse(sFileName) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
End Function
Sub sbSetMonthAndYear()
'On Error GoTo ErrHandler
sEnddate = Format(DateAdd("d", -1, Date), "DD-MMM-YY")
'Set Month
bSelection = MsgBox("Would you like to set report Last Date as : " & sEnddate & vbNewLine & "Format: DD-MMM-YY", vbYesNo, "Choose Report Last Date")
If bSelection = vbYes Then
sMonth = Format(sEnddate, "MMM")
sYear = Format(sEnddate, "YY")
Else
dCountChanceToInputbox = 1
sEnddate = InputBox("ENTER REPORT LAST DATE" & vbNewLine & "Format: DD-MMM-YYYY")
Do While IsDate(sEnddate) = False And dCountChanceToInputbox = 4
If sEnddate = "" Then
objDirFun.UnOptimizeProject
End
End If
If IsDate(sEnddate) = True Then
sForMonthYear = sEnddate
sMonth = Month("01-" & sForMonthYear)
sYear = Year("01-" & sForMonthYear)
Else
dCountChanceToInputbox = dCountChanceToInputbox + 1
sForMonthYear = ""
sForMonthYear = InputBox("ENTER REPORT LAST DATE" & vbNewLine & "Format: DD-MMM-YYYY")
End If
Loop
If IsDate(sEnddate) = True Then
sMonth = Format(sEnddate, "MMM")
sYear = Format(sEnddate, "YYYY")
Else
dErrNo = 0
GoTo ErrHandler
End If
End If
sstartdate = "01-" & sMonth & "-" & sYear
Exit Sub
ErrHandler:
Select Case dErrNo
Case 0:
MsgBox "Error occure during set report date"
'Call sbMainProcErrors("Error occure during set report date")
Case Else
MsgBox "Error Occure while validating Master File" & vbNewLine & "Procedure : sbValidateMasterFile" & vbNewLine & "Err Number : " & Err.Number & vbNewLine & "Err Description : " & Err.Description
'Call sbMainProcErrors("Error Occure while validating Master File" & ", Procedure : sbValidateMasterFile" & ", Err Number : " & Err.Number & ", Err Description : " & Err.Description)
End Select
End Sub
Function SendE_Mail()
On Error GoTo Err
Dim intLastCol As Integer, intLastRow As Integer
Dim strRange As String
Dim wsNew As Worksheet
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
Application.DisplayAlerts = False
strSourceFilePath = ActiveWorkbook.Path & "\Destination\Daily Average Volue_Apr 18 MTD_COPS.xlsx"
'copy for email body start
Set wbDestination = Workbooks.Open(strSourceFilePath)
Set wsNew = wbDestination.Worksheets.Add
wsNew.Columns(3).ColumnWidth = 25.86
intLastCol = wbDestination.Worksheets("Summary Asset").Cells(3, Columns.Count).End(xlToLeft).Column
strRange = "B2:"
strRange = strRange & wbDestination.Worksheets("Summary Asset").Cells(13, intLastCol).Address
wbDestination.Worksheets("Summary Asset").Range(strRange).SpecialCells(xlCellTypeVisible).Copy
wsNew.Range("B2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbDestination.Worksheets("Summary Asset").Range("B2:AQV13").SpecialCells(xlCellTypeVisible).Copy
wsNew.Range("B2").PasteSpecial Paste:=xlPasteFormats
With wsNew
intLastRow = .Cells(Rows.Count, 3).End(xlUp).Row
intLastCol = .Cells(3, Columns.Count).End(xlToLeft).Column
.Columns(intLastCol - 3).ColumnWidth = 11
strRange = .Cells(2, 2).Address
strRange = strRange & ":" & .Cells(13, intLastCol).Address
wsNew.Columns(intLastCol).Delete
End With
'copy for email body end
With objEmail
.To = "[EMAIL]jyoti.satam@ext.icicibank.com[/EMAIL]"
.CC = "[EMAIL]jyoti.satam@ext.icicibank.com[/EMAIL]"
.Subject = "Daily Processed Volume"
'.Body = "Hi there"
.HTMLBody = "Please find Daily Processed Volume Summary" & vbNewLine & RangetoHTML(wsNew.Range(strRange))
.display ' Display the message in Outlook.
.Attachments.Add (strSourceFilePath)
.Save
End With
wsNew.Delete
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
Exit Function
Err:
MsgBox "SendE_Mail: " & Err.Description
Resume
End Function
Function RangetoHTML(rng As Range)
' Code of Ron de Bruin - [URL='https://www.rondebruin.nl/win/s1/outlook/bmail2.htm']Mail Range/Selection in the body of the mail[/URL]
' Working in Excel 2000-2016
' (ZVI-2018-01-05: modified for CF supporting)
Dim TempFile As String, ddo As Long
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Temporary publish the rng range to a htm file
ddo = ActiveWorkbook.DisplayDrawingObjects
ActiveWorkbook.DisplayDrawingObjects = xlHide
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
Source:=Union(rng, rng).Address, _
HtmlType:=xlHtmlStatic)
.Publish True
.Delete
End With
ActiveWorkbook.DisplayDrawingObjects = ddo
'Read all data from the htm file into RangetoHTML
With CreateObject("Scripting.FileSystemObject").GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = Replace(.ReadAll, "align=center x:publishsource=", "align=left x:publishsource=")
.Close
End With
'Delete the htm file we used in this function
Kill TempFile
End Function
Last edited by a moderator:
