350 2A

Sub WAR_Pivot_To_Data()
 
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim dataRange As Range
    Dim newPt As PivotTable
    Dim tbl As ListObject
    Dim cell As Range
    Dim monthName As String
    
    ' Get the month name first
    monthName = Format(Date, "mmm")
 
    ' Set source worksheet
    Set wsSource = ThisWorkbook.Sheets("Current Month ETC vs ACWP")
    Set pt = wsSource.PivotTables("PivotTable4")
 
    ' Delete the sheet if it exists
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("WAR" & monthName).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
 
    ' Add new sheet
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "WAR" & monthName
 
    If wsTarget Is Nothing Then
        MsgBox "Error: Target worksheet not set."
        Exit Sub
    End If
 
    ' Copy PivotTable data
    pt.TableRange2.Copy
    wsTarget.Range("A1").PasteSpecial Paste:=xlPasteAll
 
    ' Get new pivot table if it exists
    On Error Resume Next
    Set newPt = wsTarget.PivotTables(1)
    On Error GoTo 0
 
    If newPt Is Nothing Then
        MsgBox "Error: PivotTable not set in the new worksheet."
        Exit Sub
    End If
 
    ' Format PivotTable
    With newPt
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels
        .ShowTableStyleRowStripes = False
        .ShowTableStyleColumnStripes = False
        For Each pf In .RowFields
            pf.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        Next pf
        .ColumnGrand = False
        .RowGrand = False
    End With
 
    wsTarget.Cells.UnMerge
    wsTarget.Columns("A").UnMerge
    wsTarget.Columns("A:B").UnMerge
 
    Application.CutCopyMode = False
    wsTarget.Columns("A:C").HorizontalAlignment = xlLeft
 
    ' Freeze panes
    wsTarget.Rows("4:4").Select
    ActiveWindow.FreezePanes = True
 
    ' Copy PivotTable data and paste as values
    Set dataRange = newPt.TableRange2
    dataRange.Copy
    dataRange.PasteSpecial Paste:=xlPasteValues
 
    ' Ensure the data range is set
    If dataRange Is Nothing Then
        MsgBox "Error: Data range not set."
        Exit Sub
    End If
 
    ' Delete the first two rows
    wsTarget.Rows("1:2").Delete
 
    ' Delete columns D:K and Q:X
    wsTarget.Range("D:K,Q:X").Delete
 
    ' Convert the remaining data to a table
    Set tbl = wsTarget.ListObjects.Add(xlSrcRange, wsTarget.Range("A1").CurrentRegion, , xlYes)
    tbl.Name = "WARDataTable"
    tbl.TableStyle = "TableStyleMedium2"
 
    ' Filter out rows where "Employee Name" is "ETC 1" or "ETC 2"
    With tbl.Range
        .AutoFilter Field:=tbl.ListColumns("Employee Name").Index, Criteria1:="<>ETC 1", Operator:=xlAnd, Criteria2:="<>ETC 2"
    End With
 
    ' Insert two columns after "Charge Number"
    Dim chargeNumberCol As ListColumn
    Set chargeNumberCol = tbl.ListColumns("Charge Number")
 
    chargeNumberCol.Range.Offset(0, 1).EntireColumn.Insert
    chargeNumberCol.Range.Offset(0, 1).EntireColumn.Insert
 
    ' Name the new columns "WP" and "Type of Work"
    chargeNumberCol.Range.Offset(0, 1).Cells(1, 1).Value = "WP"
    chargeNumberCol.Range.Offset(0, 2).Cells(1, 1).Value = "Type of Work"
 
    ' Insert three columns after "Week 5"
    Dim week5Col As ListColumn
    Set week5Col = tbl.ListColumns("Week 5 ")
 
    week5Col.Range.Offset(0, 1).EntireColumn.Insert
    week5Col.Range.Offset(0, 1).EntireColumn.Insert
    week5Col.Range.Offset(0, 1).EntireColumn.Insert
 
    ' Name the new columns "Total week1-2, SP", "Total week3-4, SP", and "Total month, SP"
    week5Col.Range.Offset(0, 1).Cells(1, 1).Value = "Total week1-2, SP"
    week5Col.Range.Offset(0, 2).Cells(1, 1).Value = "Total week3-4, SP"
    week5Col.Range.Offset(0, 3).Cells(1, 1).Value = "Total month, SP"
 
    ' Find column indexes dynamically
    Dim week1ColIndex As Integer, week2ColIndex As Integer
    Dim week3ColIndex As Integer, week4ColIndex As Integer
    Dim totalWeek12SPColIndex As Integer, totalWeek34SPColIndex As Integer
    Dim totalMonthSPColIndex As Integer
    Dim lastRow As Long
    Dim headerRow As Range
    
    ' Get the header row
    Set headerRow = wsTarget.Rows(1)
 
    ' Find column indexes
    Dim col As Range
    For Each col In headerRow.Cells
        Select Case col.Value
            Case "Week 1 "
                week1ColIndex = col.Column
            Case "Week 2"
                week2ColIndex = col.Column
            Case "Week 3"
                week3ColIndex = col.Column
            Case "Week 4"
                week4ColIndex = col.Column
            Case "Total week1-2, SP"
                totalWeek12SPColIndex = col.Column
            Case "Total week3-4, SP"
                totalWeek34SPColIndex = col.Column
            Case "Total month, SP"
                totalMonthSPColIndex = col.Column
        End Select
    Next col
 
    ' Check if required columns exist
    If week1ColIndex = 0 Or week2ColIndex = 0 Or totalWeek12SPColIndex = 0 Then
        MsgBox "Error: Could not find required columns for Total week1-2, SP.", vbCritical
        Exit Sub
    End If
 
    If week3ColIndex = 0 Or week4ColIndex = 0 Or totalWeek34SPColIndex = 0 Then
        MsgBox "Error: Could not find required columns for Total week3-4, SP.", vbCritical
        Exit Sub
    End If
 
    If totalMonthSPColIndex = 0 Then
        MsgBox "Error: Could not find required column for Total month, SP.", vbCritical
        Exit Sub
    End If
 
    ' Get last row
    lastRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row
 
    ' Insert formula in "Total week1-2, SP" column
    Dim formulaRange12 As Range
    Set formulaRange12 = wsTarget.Range(wsTarget.Cells(2, totalWeek12SPColIndex), wsTarget.Cells(lastRow, totalWeek12SPColIndex))
    formulaRange12.FormulaR1C1 = "=(RC" & week1ColIndex & " + RC" & week2ColIndex & ") / 4"
 
    ' Insert formula in "Total week3-4, SP" column
    Dim formulaRange34 As Range
    Set formulaRange34 = wsTarget.Range(wsTarget.Cells(2, totalWeek34SPColIndex), wsTarget.Cells(lastRow, totalWeek34SPColIndex))
    formulaRange34.FormulaR1C1 = "=(RC" & week3ColIndex & " + RC" & week4ColIndex & ") / 4"
 
    ' Insert formula in "Total month, SP" column
    Dim formulaRangeMonth As Range
    Set formulaRangeMonth = wsTarget.Range(wsTarget.Cells(2, totalMonthSPColIndex), wsTarget.Cells(lastRow, totalMonthSPColIndex))
    formulaRangeMonth.FormulaR1C1 = "=(RC" & week1ColIndex & " + RC" & week2ColIndex & " + RC" & week3ColIndex & " + RC" & week4ColIndex & ") / 4"
 
    ' Convert formulas to values
    formulaRange12.Copy
    formulaRange12.PasteSpecial Paste:=xlPasteValues
    formulaRange34.Copy
    formulaRange34.PasteSpecial Paste:=xlPasteValues
    formulaRangeMonth.Copy
    formulaRangeMonth.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
    MsgBox "Process completed successfully!", vbInformation
 
End Sub

Sub Create_WAR_PivotTable()
    Dim wsTarget As Worksheet
    Dim tbl As ListObject
    Dim pvtCache As PivotCache
    Dim pvtTable As PivotTable
    Dim pvtRange As Range
    Dim slicerCache As SlicerCache
    Dim monthName As String
    
    ' Get the current month name
    monthName = Format(Date, "mmm")
    
    ' Set the target worksheet
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Sheets("WAR" & monthName)
    On Error GoTo 0
    
    ' Check if the sheet exists
    If wsTarget Is Nothing Then
        MsgBox "Error: Worksheet 'WAR" & monthName & "' not found.", vbCritical
        Exit Sub
    End If
 
    ' Set the table
    On Error Resume Next
    Set tbl = wsTarget.ListObjects("WARDataTable")
    On Error GoTo 0
    
    ' Check if the table exists
    If tbl Is Nothing Then
        MsgBox "Error: Table 'WARDataTable' not found.", vbCritical
        Exit Sub
    End If
 
    ' Define Pivot Table range
    Set pvtRange = tbl.Range
 
    ' Delete any existing Pivot Table at AA10
    On Error Resume Next
    For Each pvtTable In wsTarget.PivotTables
        If Not pvtTable Is Nothing Then
            If pvtTable.TableRange2.Cells(1, 1).Address = wsTarget.Range("AA10").Address Then
                pvtTable.TableRange2.Clear
            End If
        End If
    Next pvtTable
    On Error GoTo 0
 
    ' Create Pivot Cache
    Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pvtRange)
 
    ' Create Pivot Table at AA10
    Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=wsTarget.Range("AA10"), TableName:="WAR_PivotTable")
 
    ' Set Row Field (WP)
    With pvtTable.PivotFields("WP")
        .Orientation = xlRowField
        .Position = 1
    End With
 
    ' Set Values Field (Total month, SP)
    With pvtTable.PivotFields("Total month, SP")
        .Orientation = xlDataField
        .Function = xlSum
        .NumberFormat = "#,##0.00"
    End With
 
    ' Format Pivot Table
    pvtTable.RowAxisLayout xlTabularRow
    pvtTable.ShowTableStyleRowStripes = False
    pvtTable.ShowTableStyleColumnStripes = False
 
    ' Auto-fit columns
    wsTarget.Columns.AutoFit
 
    ' Add Slicer for "Type of Work"
    Set slicerCache = wsTarget.Parent.SlicerCaches.Add2(pvtTable, "Type of Work")
    slicerCache.Slicers.Add wsTarget, , "Type_of_Work_Slicer", "Type of Work", wsTarget.Range("AE10")
 
    MsgBox "Pivot Table with Slicer created successfully in 'WAR" & monthName & "' at AA10!", vbInformation
 
End Sub

Sub InsertXLOOKUP_WP()
 
    Dim wsTarget As Worksheet
    Dim wsLookup As Worksheet
    Dim headerRow As Range
    Dim lastRow As Long
    Dim wbsColIndex As Integer
    Dim wpColIndex As Integer
    Dim wpFormulaRange As Range
    Dim col As Range
 
    ' Set the target worksheet (update the sheet name accordingly)
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Sheets("WAR" & Format(Date, "mmm"))
    Set wsLookup = ThisWorkbook.Sheets("Working")
    On Error GoTo 0
 
    ' Check if sheets exist
    If wsTarget Is Nothing Or wsLookup Is Nothing Then
        MsgBox "Error: One or both sheets do not exist.", vbCritical
        Exit Sub
    End If
 
    ' Get the header row
    Set headerRow = wsTarget.Rows(1)
 
    ' Find column indexes dynamically
    For Each col In headerRow.Cells
        Select Case Trim(col.Value)
            Case "WBS"
                wbsColIndex = col.Column
            Case "WP"
                wpColIndex = col.Column
        End Select
    Next col
 
    ' Check if required columns exist
    If wbsColIndex = 0 Or wpColIndex = 0 Then
        MsgBox "Error: Could not find required columns for WBS or WP.", vbCritical
        Exit Sub
    End If
 
    ' Get last row in the target sheet
    lastRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row
 
    ' Define the range where the formula should be inserted
    Set wpFormulaRange = wsTarget.Range(wsTarget.Cells(2, wpColIndex), wsTarget.Cells(lastRow, wpColIndex))
 
    ' Insert XLOOKUP formula
    wpFormulaRange.FormulaR1C1 = "=XLOOKUP(RC" & wbsColIndex & ", 'Working'!C1, 'Working'!C2, ""Not Found"")"
 
    ' Convert formulas to values
    wpFormulaRange.Copy
    wpFormulaRange.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
    MsgBox "XLOOKUP formula inserted and converted to values successfully!", vbInformation
 
End Sub

Sub CreatePivotTable()
 
    Dim wsData As Worksheet
    Dim wsPivot As Worksheet
    Dim pivotCache As PivotCache
    Dim pivotTable As PivotTable
    Dim pivotRange As Range
    Dim pivotDestination As Range
    Dim monthName As String
 
    ' Get the current month name
    monthName = Format(Date, "mmm")
 
    ' Set the data worksheet
    Set wsData = ThisWorkbook.Worksheets("WAR" & " " & monthName)
    Set pivotRange = wsData.Range("A1").CurrentRegion
 
    ' Delete existing "Report" sheet if it exists
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsPivot = ThisWorkbook.Worksheets("Report")
    If Not wsPivot Is Nothing Then
        wsPivot.Delete
    End If
    Application.DisplayAlerts = True
    On Error GoTo 0
 
    ' Add new "Report" sheet
    Set wsPivot = ThisWorkbook.Worksheets.Add
    wsPivot.Name = "Report"
 
    ' Set pivot table destination
    Set pivotDestination = wsPivot.Range("A3")
 
    ' Create Pivot Cache
    Set pivotCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pivotRange)
 
    ' Create PivotTable
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=pivotDestination, TableName:="MyPivotTable")
 
    ' Add fields to PivotTable
    With pivotTable
        .PivotFields("WP").Orientation = xlRowField
        .PivotFields("WP Description").Orientation = xlRowField
        .PivotFields("ETC JIRA").Orientation = xlDataField
        .PivotFields("EV").Orientation = xlDataField
        .PivotFields("AC week1-2").Orientation = xlDataField
        .PivotFields("AC week3-4").Orientation = xlDataField
        .PivotFields("AC month").Orientation = xlDataField
    End With
 
    ' Add calculated field for EV,%
    pivotTable.CalculatedFields.Add "EV,%", "=IFERROR(EV/ETC JIRA, 0)"
    pivotTable.PivotFields("EV,%").Orientation = xlDataField
    pivotTable.PivotFields("EV,%").NumberFormat = "0.00%"
 
    ' Add calculated field for AC/ETC week1-2
    pivotTable.CalculatedFields.Add "AC/ETC week1-2", "=IFERROR('AC week1-2'/'ETC JIRA', 0)"
    pivotTable.PivotFields("AC/ETC week1-2").Orientation = xlDataField
    pivotTable.PivotFields("AC/ETC week1-2").NumberFormat = "0.00%"
 
    ' Format PivotTable
    With pivotTable
        .RowAxisLayout xlTabularRow
        .ShowTableStyleRowStripes = False
        .ShowTableStyleColumnStripes = False
        .ShowTableStyleLastColumn = False
        .ShowTableStyleRowHeaders = False
        .ShowTableStyleColumnHeaders = True
        .ColumnGrand = False
        .RowGrand = False
        .TableStyle2 = "PivotStyleMedium15"
    End With
 
    ' Remove subtotals
    With pivotTable
        .PivotFields("WP").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("WP Description").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
 
    ' Rename fields to remove "Sum of"
    pivotTable.PivotFields("Sum of ETC JIRA").Caption = "ETC JIRA "
    pivotTable.PivotFields("Sum of EV").Caption = "EV "
    pivotTable.PivotFields("Sum of AC week1-2").Caption = "AC week1-2 "
    pivotTable.PivotFields("Sum of AC week3-4").Caption = "AC week3-4 "
    pivotTable.PivotFields("Sum of AC month").Caption = "AC month "
    pivotTable.PivotFields("Sum of EV,%").Caption = "EV,% "
    pivotTable.PivotFields("Sum of AC/ETC week1-2").Caption = "AC/ETC week1-2"
 
    ' Display success message
    MsgBox "Pivot Table created successfully!", vbInformation
 
End Sub