Untitled

Sub ProcessOutlookAndCSV()

    DownloadAttachmentFromOutlook

    CreateExcelAndProcessCSV
    
    AddAfterWorksheet
    
    ProcessModelWorksheet
    
    ProcessPortfolioSheets
    
    ProcessPortfolioSheets2
    
    ApplyCompareSheetFormulas
    
    ProcessCalcSheet
    
    
End Sub



Sub DownloadAttachmentFromOutlook()
    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim OutlookFolder As Object
    Dim OutlookMailItem As Object
    Dim Attachment As Object
    Dim SearchSubject As String
    Dim filePath As String
    Dim FileDate As String
    Dim SaveFolderPath As String
    Dim LatestMail As Object
    Dim MailDate As Date
    Dim MailHasAttachment As Boolean

    ' Initialize Outlook application and namespace
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

     'Select Inbox folder
    Set OutlookFolder = OutlookNamespace.Folders("reet.agrawal@nomura.com").Folders("DPM").Folders("JAC Model") ' 6 refers to olFolderInbox

    ' Set the subject line to search for
    SearchSubject = "Recommendation for 0900450/IWMJAC"

    ' Define the file path for saving the attachment
    filePath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" ' Modify this with your base file path

    ' Get today's date in YYYYMMDD format
    FileDate = Format(Date, "YYYYMMDD")

    ' Create a folder path with today's date
    SaveFolderPath = filePath & FileDate & "\"
    If Dir(SaveFolderPath, vbDirectory) = "" Then
        MkDir SaveFolderPath
    End If

    ' Loop through mails in Inbox to find the latest mail with an attachment
    MailDate = #1/1/1900# ' Initialize with a very old date
    MailHasAttachment = False

    For Each OutlookMailItem In OutlookFolder.Items
        ' Check if the subject ends with "Nomura All Weather Model Portfolio for IWM DPM"
        If Right(OutlookMailItem.Subject, Len(SearchSubject)) = SearchSubject Then
            ' Check if the email is more recent and has attachments
            If OutlookMailItem.ReceivedTime > MailDate And OutlookMailItem.Attachments.Count > 0 Then
                MailDate = OutlookMailItem.ReceivedTime
                Set LatestMail = OutlookMailItem
                MailHasAttachment = True
            End If
        End If
    Next OutlookMailItem

    ' If a mail with attachments is found, download them
    If MailHasAttachment Then
        For Each Attachment In LatestMail.Attachments
            ' Save the attachment to the folder
            Attachment.SaveAsFile SaveFolderPath & Attachment.FileName
        Next Attachment
        MsgBox "Attachment downloaded to: " & SaveFolderPath
    Else
        MsgBox "No email found with the subject and attachments: " & SearchSubject
    End If

    ' Cleanup
    Set OutlookMailItem = Nothing
    Set OutlookFolder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
End Sub



Sub CreateExcelAndProcessCSV()
    Dim filePath As String
    Dim FileDate As String
    Dim SaveFolderPath As String
    Dim LatestCSV As String
    Dim CSVPath As String
    Dim NewExcel As Workbook
    Dim CSVWorkbook As Workbook
    Dim CSVWorksheet As Worksheet
    Dim TargetWorksheet As Worksheet
    Dim FilterRange As Range
    Dim ColumnsToCopy As Variant
    Dim Column As Variant
    Dim CopyRow As Long
    Dim i As Integer
    ' Define the base file path for saving the attachment
    filePath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" ' Modify this with your base file path
    CSVPath = "\\asiapac.nom\data\SIN\WMD\Apps\Avaloq\IA_PROD\MIS\" ' Specify your CSV folder path here
    ' Get today's date in YYYYMMDD format
    FileDate = Format(Date, "YYYYMMDD")
    ' Create a folder path with today's date
    SaveFolderPath = filePath & FileDate & "\"
    If Dir(SaveFolderPath, vbDirectory) = "" Then
        MkDir SaveFolderPath
    End If
    ' Find the latest CSV file in the specified path
    LatestCSV = GetLatestFile(CSVPath, "Position_*.csv")
    If LatestCSV = "" Then
        MsgBox "No CSV file found in the specified path.", vbCritical
        Exit Sub
    End If
    ' Copy the latest CSV file to the new folder
    FileCopy CSVPath & LatestCSV, SaveFolderPath & LatestCSV
    ' Create a new Excel file named JAC_Rebal_{date}
    Set NewExcel = Application.Workbooks.Add
    NewExcel.SaveAs SaveFolderPath & "JAC_Rebal_" & FileDate & ".xlsx"
    ' Open the copied CSV file
    Set CSVWorkbook = Workbooks.Open(SaveFolderPath & LatestCSV)
    Set CSVWorksheet = CSVWorkbook.Sheets(1)
    ' Define columns to copy
    ColumnsToCopy = Array(10, 22, 17, 15, 7, 20, 12, 16) ' Columns I, V, Q, O, G, T
    ' Process for both portfolios
    For i = 1 To 2
        ' Create a new sheet for each portfolio
        Set TargetWorksheet = NewExcel.Sheets.Add
        TargetWorksheet.Name = "Portfolio " & i
        ' Apply filter based on portfolio
        Set FilterRange = CSVWorksheet.UsedRange
        If i = 1 Then
            FilterRange.AutoFilter Field:=2, Criteria1:="23138026"
        Else
            FilterRange.AutoFilter Field:=2, Criteria1:="23085680"
        End If
        ' Copy specified columns
        CopyRow = 1
        For Each Column In ColumnsToCopy
            ' Copy filtered data from each column
            On Error Resume Next
            CSVWorksheet.Columns(Column).SpecialCells(xlCellTypeVisible).Copy
            TargetWorksheet.Cells(1, CopyRow).PasteSpecial xlPasteValues
            On Error GoTo 0
            CopyRow = CopyRow + 1
        Next Column
        ' Clear filters
        CSVWorksheet.AutoFilterMode = False
    Next i
    ' Delete the default Sheet1
    Application.DisplayAlerts = False
    NewExcel.Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    ' Cleanup
    CSVWorkbook.Close False
    NewExcel.Save
    Application.CutCopyMode = False
    MsgBox "Data processed and saved to: " & NewExcel.FullName
    Set CSVWorkbook = Nothing
    Set NewExcel = Nothing
End Sub



Function GetLatestFile(FolderPath As String, FilePattern As String) As String
    Dim FileName As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim FileDate As Date

    FileName = Dir(FolderPath & FilePattern)
    Do While FileName <> ""
        FileDate = FileDateFromName(FileName)
        If FileDate > LatestDate Then
            LatestDate = FileDate
            LatestFile = FileName
        End If
        FileName = Dir
    Loop

    GetLatestFile = LatestFile
End Function

Function FileDateFromName(FileName As String) As Date
    Dim DatePart As String
    On Error Resume Next
    DatePart = Mid(FileName, InStr(FileName, "_") + 1, 8)
    FileDateFromName = DateSerial(Left(DatePart, 4), Mid(DatePart, 5, 2), Right(DatePart, 2))
End Function


Sub AddAfterWorksheet()
    Dim SearchFolderPath As String
    Dim SearchFile As String
    Dim TargetFilePath As String
    Dim FoundFile As String
    Dim SourceWorkbook As Workbook
    Dim TargetWorkbook As Workbook
    Dim SourceWorksheet As Worksheet
    Dim CopiedWorksheet As Worksheet
    
    ' Define the folder path based on today's date
    SearchFolderPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\"
    
    ' Search for a file containing "IWM JAC"
    SearchFile = Dir(SearchFolderPath & "*IWMJAC*.xls*") ' Matches .xls or .xlsx/.xlsm files
    
    If SearchFile = "" Then
        MsgBox "No file containing 'IWM JAC' found in the folder.", vbCritical
        Exit Sub
    End If
    
    FoundFile = SearchFolderPath & SearchFile
    
    ' Open the found file
    Set SourceWorkbook = Workbooks.Open(FoundFile)
    
    ' Check if the worksheet "After" exists
    On Error Resume Next
    Set SourceWorksheet = SourceWorkbook.Sheets("After")
    On Error GoTo 0
    
    If SourceWorksheet Is Nothing Then
        MsgBox "'After' worksheet not found in the file: " & FoundFile, vbCritical
        SourceWorkbook.Close False
        Exit Sub
    End If
    
    ' Open the target JAC Rebal file
    TargetFilePath = SearchFolderPath & "JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    If Dir(TargetFilePath) = "" Then
        MsgBox "Target JAC Rebal file not found.", vbCritical
        SourceWorkbook.Close False
        Exit Sub
    End If
    Set TargetWorkbook = Workbooks.Open(TargetFilePath)
    
    ' Copy the "After" worksheet to the JAC Rebal file
    SourceWorksheet.Copy After:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
    Set CopiedWorksheet = TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
    CopiedWorksheet.Name = "Model"
    
    ' Save and close the workbooks
    TargetWorkbook.Save
    SourceWorkbook.Close False
    TargetWorkbook.Close
    
    MsgBox "'After' worksheet copied successfully to JAC Rebal file as 'Model'."
End Sub


Sub ProcessModelWorksheet()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim ModelWorksheet As Worksheet
    
    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    
    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If
    
    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)
    
    ' Check if the "Model" worksheet exists
    On Error Resume Next
    Set ModelWorksheet = JACWorkbook.Sheets("Model")
    On Error GoTo 0
    
    If ModelWorksheet Is Nothing Then
        MsgBox "'Model' worksheet not found in JAC_Rebal file.", vbCritical
        JACWorkbook.Close False
        Exit Sub
    End If
    
    ' Activate the Model worksheet
    ModelWorksheet.Activate
    
    ' 1) Delete row 1
    ModelWorksheet.Rows(1).Delete
    
    ' 2) Insert 2 columns between column A and B, and clear their content
    ModelWorksheet.Columns("B:C").Insert Shift:=xlToRight
    ModelWorksheet.Columns("B:C").ClearContents
    
    ' 3) Perform Text to Columns operation on column A
    With ModelWorksheet.Columns("A")
        .TextToColumns Destination:=ModelWorksheet.Columns("A"), _
                       DataType:=xlDelimited, _
                       TextQualifier:=xlDoubleQuote, _
                       ConsecutiveDelimiter:=False, _
                       Tab:=False, _
                       Semicolon:=False, _
                       Comma:=False, _
                       Space:=True, _
                       Other:=False
    End With
    
    ' Save and close the workbook
    JACWorkbook.Save
    JACWorkbook.Close
    
    MsgBox "Model worksheet processed successfully in JAC_Rebal file."
End Sub

Sub ProcessPortfolioSheets()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim Sheet As Worksheet
    Dim SheetName As String
    
    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    
    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If
    
    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)
    
    ' Loop through all sheets with names "Portfolio {i}"
    For Each Sheet In JACWorkbook.Sheets
        If Sheet.Name Like "Portfolio *" Then
            Sheet.Activate
            
            ' 1) Insert 1 column between column A and column B, and clear its content
            Sheet.Columns("B").Insert Shift:=xlToRight
            Sheet.Columns("B").ClearContents
            
            ' 2) Perform Text to Columns operation on column A
            With Sheet.Columns("A")
                .TextToColumns Destination:=Sheet.Columns("A"), _
                               DataType:=xlDelimited, _
                               TextQualifier:=xlDoubleQuote, _
                               ConsecutiveDelimiter:=False, _
                               Tab:=False, _
                               Semicolon:=False, _
                               Comma:=False, _
                               Space:=True, _
                               Other:=False
            End With
        End If
    Next Sheet
    
    ' Save and close the workbook
    JACWorkbook.Save
    JACWorkbook.Close
    
    MsgBox "Portfolio sheets processed successfully in JAC_Rebal file."
End Sub


Sub ProcessPortfolioSheets2()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim Sheet As Worksheet
    Dim CompareSheet As Worksheet
    Dim ModelSheet As Worksheet
    Dim LastRow As Long
    Dim PortfolioCounter As Integer
    Dim PasteColumn As String
    Dim wsName As String
    
    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    
    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If
    
    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)
    
    ' Ensure there's no existing "Compare" worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    JACWorkbook.Sheets("Compare").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' Create a new "Compare" worksheet
    Set CompareSheet = JACWorkbook.Sheets.Add
    CompareSheet.Name = "Compare"
    CompareSheet.Range("A1").Value = "Model"
    CompareSheet.Columns("A").AutoFit
    
    ' Copy data from the "Model" worksheet
    On Error Resume Next
    Set ModelSheet = JACWorkbook.Sheets("Model")
    On Error GoTo 0
    If Not ModelSheet Is Nothing Then
        LastRow = ModelSheet.Cells(ModelSheet.Rows.Count, "A").End(xlUp).Row
        ModelSheet.Range("A2:A" & LastRow).Copy Destination:=CompareSheet.Range("A2")
        CompareSheet.Columns("A").AutoFit
    Else
        MsgBox "Model sheet not found in JAC_Rebal file.", vbCritical
        Exit Sub
    End If
    
    ' Initialize portfolio counter
    PortfolioCounter = 1
    
    ' Loop through all sheets with names "Portfolio *"
    For Each Sheet In JACWorkbook.Sheets
        If Sheet.Name Like "Portfolio *" Then
            Sheet.Activate
            wsName = "P" & PortfolioCounter
            
            ' Determine paste column (F for P1, H for P2, J for P3, etc.)
            PasteColumn = Chr(69 + PortfolioCounter * 3)
            
            ' Find the last row in column A
            LastRow = Sheet.Cells(Sheet.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Then
                ' Apply filter in column H for "Equities"
                Sheet.Rows(1).AutoFilter Field:=8, Criteria1:="Equities"
                
                ' Copy filtered data from column A
                If Sheet.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Count > 0 Then
                    Sheet.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
                        Destination:=CompareSheet.Cells(2, PasteColumn)
                    
                    ' Label the portfolio column
                    CompareSheet.Cells(1, PasteColumn).Value = wsName
                    CompareSheet.Columns(PasteColumn).AutoFit
                End If
                
                ' Turn off filter
                Sheet.AutoFilterMode = False
            End If
            
            ' Increment portfolio counter
            PortfolioCounter = PortfolioCounter + 1
        End If
    Next Sheet
    
    ' Save and close the workbook
    JACWorkbook.Save
    JACWorkbook.Close
    
    MsgBox "Portfolio sheets processed and data consolidated successfully in the Compare sheet."
End Sub

Sub ApplyCompareSheetFormulas()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim CompareSheet As Worksheet
    Dim LastRowA As Long, LastRowH As Long, LastRowK As Long
    Dim i As Long
    
    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    
    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If
    
    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)
    
    ' Ensure "Compare" sheet exists
    On Error Resume Next
    Set CompareSheet = JACWorkbook.Sheets("Compare")
    On Error GoTo 0
    If CompareSheet Is Nothing Then
        MsgBox "Compare sheet not found. Please ensure it exists before running this macro.", vbCritical
        JACWorkbook.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' Find the last row for column A
    LastRowA = CompareSheet.Cells(CompareSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Apply VLOOKUP formulas for column B and C based on column A
    If LastRowA > 1 Then
        For i = 2 To LastRowA
            CompareSheet.Cells(i, 2).Formula = "=IFERROR(VLOOKUP(A" & i & ",H:H,1,0),"""")"
            CompareSheet.Cells(i, 3).Formula = "=IFERROR(VLOOKUP(A" & i & ",K:K,1,0),"""")"
        Next i
    End If
    
    ' Find the last row for column H
    LastRowH = CompareSheet.Cells(CompareSheet.Rows.Count, "H").End(xlUp).Row
    
    ' Apply VLOOKUP formula for column I based on column H
    If LastRowH > 1 Then
        For i = 2 To LastRowH
            CompareSheet.Cells(i, 9).Formula = "=IFERROR(VLOOKUP(H" & i & ",A:A,1,0),"""")"
        Next i
    End If
    
    ' Find the last row for column K
    LastRowK = CompareSheet.Cells(CompareSheet.Rows.Count, "K").End(xlUp).Row
    
    ' Apply VLOOKUP formula for column L based on column K
    If LastRowK > 1 Then
        For i = 2 To LastRowK
            CompareSheet.Cells(i, 12).Formula = "=IFERROR(VLOOKUP(K" & i & ",A:A,1,0),"""")"
        Next i
    End If
    
    ' Save and close the workbook
    JACWorkbook.Save
    JACWorkbook.Close
    
    MsgBox "Formulas applied successfully in the Compare sheet."
End Sub

Sub ProcessCalcSheet()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim CalcSheet As Worksheet
    Dim ModelSheet As Worksheet
    Dim PortfolioSheet As Worksheet
    Dim LastRowModel As Long
    Dim LastRowCalc As Long
    Dim PortfolioCounter As Integer
    Dim PasteColumn As Integer
    Dim wsName As String
    Dim i As Long
    
    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"
    
    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If
    
    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)
    
    ' Rename Sheet2 to "Calc" if it exists
    On Error Resume Next
    Set CalcSheet = JACWorkbook.Sheets("Sheet2")
    If Not CalcSheet Is Nothing Then
        CalcSheet.Name = "Calc"
    Else
        MsgBox "Sheet2 not found. Please ensure the sheet exists.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    Set CalcSheet = JACWorkbook.Sheets("Calc")
    Set ModelSheet = JACWorkbook.Sheets("Model")
    
    ' Get ISINs from Model sheet
    LastRowModel = ModelSheet.Cells(ModelSheet.Rows.Count, "A").End(xlUp).Row
    ModelSheet.Range("A2:A" & LastRowModel).Copy Destination:=CalcSheet.Range("B3")
    
    ' Format B2
    With CalcSheet.Range("B2")
        .Value = "Model"
        .Interior.Color = RGB(84, 130, 53)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
    
    ' Format C2
    With CalcSheet.Range("C2")
        .Value = "Model Wt"
        .Interior.Color = RGB(84, 130, 53)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
    
    ' Apply formula in C3 onwards
    LastRowCalc = CalcSheet.Cells(CalcSheet.Rows.Count, "B").End(xlUp).Row
    For i = 3 To LastRowCalc
        CalcSheet.Cells(i, 3).Formula = "=IFERROR(VLOOKUP(B" & i & ",'Model'!A:G,7,0),0)"
    Next i
    
    ' Loop for Portfolio sheets
    PortfolioCounter = 1
    PasteColumn = 4 ' Starting at column D
    For Each PortfolioSheet In JACWorkbook.Sheets
        If PortfolioSheet.Name Like "Portfolio *" Then
            wsName = "P" & PortfolioCounter
            
            ' Format Portfolio header
            With CalcSheet.Cells(2, PasteColumn)
                .Value = wsName
                If PortfolioCounter = 1 Then
                    .Interior.Color = RGB(192, 0, 0)
                ElseIf PortfolioCounter = 2 Then
                    .Interior.Color = RGB(31, 78, 120)
                End If
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
            End With
            
            ' Format Change header
            With CalcSheet.Cells(2, PasteColumn + 1)
                .Value = "Change in " & wsName
                If PortfolioCounter = 1 Then
                    .Interior.Color = RGB(192, 0, 0)
                ElseIf PortfolioCounter = 2 Then
                    .Interior.Color = RGB(31, 78, 120)
                End If
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
            End With
            
            ' Apply formulas
            For i = 3 To LastRowCalc
                CalcSheet.Cells(i, PasteColumn).Formula = "=IFERROR(VLOOKUP(B" & i & ",'" & PortfolioSheet.Name & "'!A:C,3,0),0)"
                CalcSheet.Cells(i, PasteColumn + 1).Formula = "=C" & i & "-" & Chr(64 + PasteColumn) & i
            Next i
            
            ' Update for next portfolio
            PortfolioCounter = PortfolioCounter + 1
            PasteColumn = PasteColumn + 2 ' Move to the next pair of columns
        End If
    Next PortfolioSheet
    
    ' Save the workbook
    JACWorkbook.Save
    JACWorkbook.Close
    
    MsgBox "Calc sheet processed successfully."
End Sub

Sub ProcessFinalSheet()
    Dim JACRebalPath As String
    Dim JACWorkbook As Workbook
    Dim CalcSheet As Worksheet
    Dim FinalSheet As Worksheet
    Dim LastRowCalc As Long
    Dim LastRowFinal As Long
    Dim LastRowE1 As Long
    Dim LastRowE2 As Long
    Dim LastColumnE1 As Long
    Dim LastColumnE2 As Long
    Dim i As Long
    Dim HeaderRow As Long

    ' Define the file path for the JAC_Rebal file
    JACRebalPath = "\\asiapac.nom\data\MUM\IWM\India_IWM_IPAS\Reet\JAC Rebal Code\" & Format(Date, "YYYYMMDD") & "\JAC_Rebal_" & Format(Date, "YYYYMMDD") & ".xlsx"

    ' Check if the JAC_Rebal file exists
    If Dir(JACRebalPath) = "" Then
        MsgBox "JAC_Rebal file not found. Please run the previous steps first.", vbCritical
        Exit Sub
    End If

    ' Open the JAC_Rebal file
    Set JACWorkbook = Workbooks.Open(JACRebalPath)

    ' Create or clear the "Final" sheet
    On Error Resume Next
    Set FinalSheet = JACWorkbook.Sheets("Final")
    If FinalSheet Is Nothing Then
        Set FinalSheet = JACWorkbook.Sheets.Add
        FinalSheet.Name = "Final"
    Else
        FinalSheet.Cells.Clear
    End If
    On Error GoTo 0

    Set CalcSheet = JACWorkbook.Sheets("Calc")
    
    HeaderRow = 2

    ' Apply filter in Calc sheet, column E for values > 0.2 or < -0.2
    LastRowCalc = CalcSheet.Cells(CalcSheet.Rows.Count, "E").End(xlUp).Row
    CalcSheet.Rows(HeaderRow).AutoFilter Field:=4, Criteria1:=">0.2", Operator:=xlOr, Criteria2:="<-0.2"

    ' Copy filtered data for Table 1
    If CalcSheet.AutoFilterMode Then
        If CalcSheet.Range("B3:B" & LastRowCalc).SpecialCells(xlCellTypeVisible).Count > 1 Then
            CalcSheet.Range("B2:E" & LastRowCalc).SpecialCells(xlCellTypeVisible).Copy Destination:=FinalSheet.Range("B2")
        End If
    End If
    CalcSheet.AutoFilter.ShowAllData

    LastRowE1 = FinalSheet.Cells(FinalSheet.Rows.Count, "B").End(xlUp).Row
    LastColumnE1 = FinalSheet.Cells(HeaderRow, FinalSheet.Columns.Count).End(xlToLeft).Column

    ' Insert Action column for Table 1
    FinalSheet.Cells(HeaderRow, LastColumnE1 + 1).Value = "Action"
    For i = HeaderRow + 1 To LastRowE1
        If FinalSheet.Cells(i, "E").Value < 0 Then
            FinalSheet.Cells(i, LastColumnE1 + 1).Value = "Sell"
            FinalSheet.Cells(i, LastColumnE1 + 1).Interior.Color = RGB(252, 228, 214)
        ElseIf FinalSheet.Cells(i, "E").Value > 0 Then
            FinalSheet.Cells(i, LastColumnE1 + 1).Value = "Buy"
            FinalSheet.Cells(i, LastColumnE1 + 1).Interior.Color = RGB(226, 239, 218)
        End If
    Next i

    ' Apply filter in Calc sheet, column G for values > 0.2 or < -0.2
    LastRowCalc = CalcSheet.Cells(CalcSheet.Rows.Count, "G").End(xlUp).Row
    CalcSheet.Rows(HeaderRow).AutoFilter Field:=6, Criteria1:=">0.2", Operator:=xlOr, Criteria2:="<-0.2"

    ' Copy filtered data for Table 2
    LastRowFinal = FinalSheet.Cells(FinalSheet.Rows.Count, "B").End(xlUp).Row + 4
    If CalcSheet.AutoFilterMode Then
        If CalcSheet.Range("B3:B" & LastRowCalc).SpecialCells(xlCellTypeVisible).Count > 1 Then
            CalcSheet.Range("B2:C" & LastRowCalc).SpecialCells(xlCellTypeVisible).Copy Destination:=FinalSheet.Range("B" & LastRowFinal)
            CalcSheet.Range("F2:F" & LastRowCalc).SpecialCells(xlCellTypeVisible).Copy Destination:=FinalSheet.Range("D" & LastRowFinal)
            CalcSheet.Range("G2:G" & LastRowCalc).SpecialCells(xlCellTypeVisible).Copy Destination:=FinalSheet.Range("E" & LastRowFinal)
        End If
    End If

    LastRowE2 = FinalSheet.Cells(FinalSheet.Rows.Count, "B").End(xlUp).Row
    LastColumnE2 = FinalSheet.Cells(HeaderRow + 4, FinalSheet.Columns.Count).End(xlToLeft).Column

    ' Insert Action column for Table 2
    FinalSheet.Cells(LastRowFinal, LastColumnE2).Value = "Action"
    For i = LastRowFinal + 1 To LastRowE2
        If FinalSheet.Cells(i, "E").Value < 0 Then
            FinalSheet.Cells(i, LastColumnE2 + 1).Value = "Sell"
            FinalSheet.Cells(i, LastColumnE2 + 1).Interior.Color = RGB(252, 228, 214)
        ElseIf FinalSheet.Cells(i, "E").Value > 0 Then
            FinalSheet.Cells(i, LastColumnE2 + 1).Value = "Buy"
            FinalSheet.Cells(i, LastColumnE2 + 1).Interior.Color = RGB(226, 239, 218)
        End If
    Next i

    ' Sum Change column for Table 1
    FinalSheet.Cells(LastRowE1 + 1, "E").Value = Application.WorksheetFunction.Sum(FinalSheet.Range("E3:E" & LastRowE1))

    ' Sum Change column for Table 2
    FinalSheet.Cells(LastRowE2 + 1, "E").Value = Application.WorksheetFunction.Sum(FinalSheet.Range("E" & LastRowFinal + 1 & ":E" & LastRowE2))

    ' Add VLOOKUP formula for Table 1
    FinalSheet.Cells(HeaderRow, LastColumnE1 + 2).Value = "Price"
    For i = HeaderRow + 1 To LastRowE1
        FinalSheet.Cells(i, LastColumnE1 + 2).Formula = "=VLOOKUP(B" & i & ", 'Portfolio 1'!A:E, 5, 0)"
    Next i

    ' Add VLOOKUP formula for Table 2
    FinalSheet.Cells(LastRowFinal, LastColumnE2 + 2).Value = "Price"
    For i = LastRowFinal + 1 To LastRowE2
        FinalSheet.Cells(i, LastColumnE2 + 2).Formula = "=VLOOKUP(B" & i & ", 'Portfolio 2'!A:E, 5, 0)"
    Next i

    ' Save and close the workbook
    JACWorkbook.Save
    JACWorkbook.Close

    MsgBox "Final sheet processed successfully."
End Sub