Option Explicit

' Main procedure to add new PM columns to the active worksheet
Sub AddPMColumnsToActiveSheet()
    Dim wsActive As Worksheet, wsNew As Worksheet
    Dim headerRow As Long
    Dim newColumns As Variant
    Dim i As Long, j As Long
    Dim hiddenCols As Collection
    Dim userInput As String
    
    ' Define the new columns to add
    ' Array format: (Header Label, Insert After This Column Header)
    newColumns = Array( _
        Array("Who", "Resource IDs"), _
        Array("Start Update", "Finish"), _
	Array("Who Update","Start"), _
        Array("Progress Update %", "Activity % Complete"), _
        Array("PM Code", "Total Float"), _
        Array("PM ToDo", "PM Code"), _
        Array("PM Report", "PM ToDo") _
    )
    
    On Error GoTo ErrorHandler
    
    ' Work with the active worksheet
    Set wsActive = ActiveSheet
    
    If wsActive Is Nothing Then
        MsgBox "No active worksheet found!", vbCritical, "Error"
        Exit Sub
    End If
    
    ' Confirm with user
    If MsgBox("This will create a copy of the active sheet '" & wsActive.Name & _
              "' and add new PM columns." & vbCrLf & vbCrLf & _
              "Continue?", vbYesNo + vbQuestion, "Add PM Columns") = vbNo Then
        Exit Sub
    End If
    
    ' Find header row (search first 20 rows)
    headerRow = FindHeaderRow(wsActive, 20)
    
    If headerRow = 0 Then
        ' Prompt user for header row
        userInput = InputBox("Header row not found automatically." & vbCrLf & _
                           "Please enter the row number containing headers " & _
                           "(e.g., 'Activity ID', 'Activity Name', etc.):", _
                           "Header Row", "11")
        
        If userInput = "" Then
            MsgBox "Operation cancelled.", vbInformation
            Exit Sub
        End If
        
        If Not IsNumeric(userInput) Then
            MsgBox "Invalid row number!", vbCritical
            Exit Sub
        End If
        
        headerRow = CLng(userInput)
        
        ' Validate the row number
        If headerRow < 1 Or headerRow > wsActive.Rows.Count Then
            MsgBox "Invalid row number!", vbCritical
            Exit Sub
        End If
    End If
    
    ' Store hidden columns from active sheet
    Set hiddenCols = New Collection
    Dim maxCol As Long
    maxCol = wsActive.UsedRange.Columns.Count
    
    For i = 1 To maxCol
        If wsActive.Columns(i).Hidden Then
            hiddenCols.Add i
        End If
    Next i
    
    ' Display what will be added
    Dim msg As String
    msg = "Found header row at row " & headerRow & vbCrLf & vbCrLf
    msg = msg & "Will add " & UBound(newColumns) + 1 & " new columns:" & vbCrLf
    For i = 0 To UBound(newColumns)
        msg = msg & "• " & newColumns(i)(0) & " (after '" & newColumns(i)(1) & "')" & vbCrLf
    Next i
    msg = msg & "• Blank separator column (after PM Report)" & vbCrLf
    msg = msg & "• Freeze panes at first date column" & vbCrLf
    msg = msg & vbCrLf & "Hidden columns will be preserved." & vbCrLf
    msg = msg & "New sheet will be named: PM_Fields-" & Format(Now, "yyyy-mm-dd") & vbCrLf & vbCrLf
    msg = msg & "Proceed?"
    
    If MsgBox(msg, vbYesNo + vbQuestion, "Confirm New Columns") = vbNo Then
        Exit Sub
    End If
    
    ' Duplicate the active sheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    wsActive.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set wsNew = ActiveSheet
    
    ' Process new columns with improved logic
    Dim insertedCount As Long
    insertedCount = 0
    
    ' Process columns in groups to maintain adjacency
    ' Start with PM Code, PM ToDo, PM Report group (indices 3, 4, 5)
    Dim pmCodePos As Long
    pmCodePos = FindColumnPosition(wsNew, headerRow, "Total Float")
    
    If pmCodePos > 0 Then
        ' Insert all three PM columns together at once
        ' Insert from right to left: PM Report, PM ToDo, PM Code
        For i = 5 To 3 Step -1
            wsNew.Columns(pmCodePos + 1).Insert Shift:=xlToRight
            With wsNew.Cells(headerRow, pmCodePos + 1)
                .Value = newColumns(i)(0)
                .Interior.Color = vbYellow
                .Font.Bold = True
                .Borders.LineStyle = xlContinuous
            End With
            insertedCount = insertedCount + 1
        Next i
    Else
        MsgBox "Warning: Could not find 'Total Float' column for PM columns", vbExclamation
    End If
    
    ' Process Progress Update % (index 2)
    Dim progressPos As Long
    progressPos = FindColumnPosition(wsNew, headerRow, "Activity % Complete")
    
    If progressPos > 0 Then
        wsNew.Columns(progressPos + 1).Insert Shift:=xlToRight
        With wsNew.Cells(headerRow, progressPos + 1)
            .Value = newColumns(2)(0)
            .Interior.Color = vbYellow
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
        End With
        insertedCount = insertedCount + 1
    Else
        MsgBox "Warning: Could not find 'Activity % Complete' column", vbExclamation
    End If
    
    ' Process Start Update (index 1)
    Dim startUpdatePos As Long
    startUpdatePos = FindColumnPosition(wsNew, headerRow, "Finish")
    
    If startUpdatePos > 0 Then
        wsNew.Columns(startUpdatePos + 1).Insert Shift:=xlToRight
        With wsNew.Cells(headerRow, startUpdatePos + 1)
            .Value = newColumns(1)(0)
            .Interior.Color = vbYellow
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
        End With
        insertedCount = insertedCount + 1
    Else
        MsgBox "Warning: Could not find 'Finish' column", vbExclamation
    End If
    
    ' Process Who (index 0)
    Dim whoPos As Long
    whoPos = FindColumnPosition(wsNew, headerRow, "Resource IDs")
    
    If whoPos > 0 Then
        wsNew.Columns(whoPos + 1).Insert Shift:=xlToRight
        With wsNew.Cells(headerRow, whoPos + 1)
            .Value = newColumns(0)(0)
            .Interior.Color = vbYellow
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
        End With
        insertedCount = insertedCount + 1
    Else
        MsgBox "Warning: Could not find 'Resource IDs' column", vbExclamation
    End If
    
    ' Restore hidden columns (adjust for inserted columns)
    On Error Resume Next ' In case column index is out of range
    
    Dim origCol As Long
    For i = 1 To hiddenCols.Count
        origCol = hiddenCols(i)
        
        ' Count how many columns were inserted before this position
        Dim adjustmentCount As Long
        adjustmentCount = 0
        
        ' Check each insertion point
        If whoPos > 0 And whoPos < origCol Then adjustmentCount = adjustmentCount + 1
        If startUpdatePos > 0 And startUpdatePos < origCol Then adjustmentCount = adjustmentCount + 1
        If progressPos > 0 And progressPos < origCol Then adjustmentCount = adjustmentCount + 1
        If pmCodePos > 0 And pmCodePos < origCol Then adjustmentCount = adjustmentCount + 3 ' 3 PM columns
        
        ' Hide the adjusted column
        wsNew.Columns(origCol + adjustmentCount).Hidden = True
    Next i
    
    On Error GoTo ErrorHandler
    
    ' Rename the new sheet
    Dim newSheetName As String
    newSheetName = "PM_Fields-" & Format(Now, "yyyy-mm-dd")
    
    On Error Resume Next
    wsNew.Name = newSheetName
    If Err.Number <> 0 Then
        ' If naming fails, try with time
        wsNew.Name = "PM_Fields-" & Format(Now, "yyyy-mm-dd_HHmmss")
    End If
    On Error GoTo ErrorHandler
    
    ' Clean up
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    ' Final message
    MsgBox "Sheet updated successfully!" & vbCrLf & vbCrLf & _
           "✓ Added " & insertedCount & " new columns with yellow headers" & vbCrLf & _
           "✓ PM Code, PM ToDo, and PM Report are now adjacent" & vbCrLf & _
           "✓ Maintained hidden column settings" & vbCrLf & _
           "✓ New sheet: " & wsNew.Name, vbInformation, "Success"
    
    ' Activate the new sheet
    wsNew.Activate
    
    Exit Sub
    
ErrorHandler:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Error occurred: " & Err.Description & vbCrLf & _
           "Error Number: " & Err.Number, vbCritical, "Error"
End Sub

' Find the header row by looking for Activity-related keywords
Function FindHeaderRow(ws As Worksheet, maxRows As Long) As Long
    Dim i As Long, j As Long
    Dim cellValue As String
    Dim keywordCount As Long
    
    FindHeaderRow = 0
    
    ' Keywords to identify header row
    Dim keywords As Variant
    keywords = Array("Activity ID", "Activity Name", "Duration", "Start", "Finish", _
                    "Resource", "Complete", "Float", "Predecessors", "Successors")
    
    For i = 1 To WorksheetFunction.Min(maxRows, ws.UsedRange.Rows.Count)
        keywordCount = 0
        
        ' Check first 30 columns for keywords
        For j = 1 To WorksheetFunction.Min(30, ws.UsedRange.Columns.Count)
            cellValue = CStr(ws.Cells(i, j).Value)
            
            If Len(cellValue) > 0 Then
                Dim k As Long
                For k = 0 To UBound(keywords)
                    If InStr(1, cellValue, keywords(k), vbTextCompare) > 0 Then
                        keywordCount = keywordCount + 1
                        Exit For
                    End If
                Next k
            End If
        Next j
        
        ' If we found multiple keywords, this is likely the header row
        If keywordCount >= 3 Then
            FindHeaderRow = i
            Exit Function
        End If
    Next i
End Function

' Find the column position of a specific header
Function FindColumnPosition(ws As Worksheet, headerRow As Long, headerText As String) As Long
    Dim col As Long
    Dim maxCol As Long
    
    FindColumnPosition = 0
    maxCol = ws.UsedRange.Columns.Count + 10 ' Check a bit beyond used range
    
    For col = 1 To maxCol
        If CStr(ws.Cells(headerRow, col).Value) = headerText Then
            FindColumnPosition = col
            Exit Function
        End If
    Next col
End Function

' Alternative entry point for testing
Sub TestAddPMColumns()
    Call AddPMColumnsToActiveSheet
End Sub

' Utility function to list current headers (for debugging)
Sub ListCurrentHeaders()
    Dim ws As Worksheet
    Dim headerRow As Long
    Dim col As Long
    Dim headers As String
    
    Set ws = ActiveSheet
    headerRow = FindHeaderRow(ws, 20)
    
    If headerRow = 0 Then
        headerRow = CLng(InputBox("Enter header row number:", "Header Row", "11"))
    End If
    
    headers = "Headers found in row " & headerRow & ":" & vbCrLf & vbCrLf
    
    For col = 1 To WorksheetFunction.Min(50, ws.UsedRange.Columns.Count)
        If Not IsEmpty(ws.Cells(headerRow, col).Value) Then
            headers = headers & "Col " & col & ": " & ws.Cells(headerRow, col).Value & vbCrLf
        End If
    Next col
    
    MsgBox headers, vbInformation, "Current Headers"
End Sub