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
    
    ' Use a dictionary to store the final positions for easier hidden column restoration
    Dim finalPositions As Object
    Set finalPositions = CreateObject("Scripting.Dictionary")
    
    ' Insert columns from right to left to maintain positions
    For i = UBound(newColumns) To 0 Step -1
        Dim headerToInsert As String
        Dim afterHeaderName As String
        headerToInsert = newColumns(i)(0)
        afterHeaderName = newColumns(i)(1)
        
        Dim foundCol As Long
        foundCol = FindColumnPosition(wsNew, headerRow, afterHeaderName)
        
        If foundCol > 0 Then
            ' Insert column and set header
            wsNew.Columns(foundCol + 1).Insert Shift:=xlToRight
            With wsNew.Cells(headerRow, foundCol + 1)
                .Value = headerToInsert
                .Interior.Color = vbYellow
                .Font.Bold = True
                .Borders.LineStyle = xlContinuous
            End With
            
            ' Store the final position for restoration of hidden columns
            finalPositions(headerToInsert) = foundCol + 1
            insertedCount = insertedCount + 1
        Else
            MsgBox "Warning: Could not find position for column '" & headerToInsert & _
                   "'. It should be inserted after '" & afterHeaderName & "'", vbExclamation
        End If
    Next i
    
    ' 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)
        
        Dim adjustmentCount As Long
        adjustmentCount = 0
        
        ' Iterate through the final positions and count how many were inserted before this one
        Dim newColHeader As Variant
        For Each newColHeader In finalPositions.Keys
            If finalPositions(newColHeader) < origCol Then
                adjustmentCount = adjustmentCount + 1
            End If
        Next newColHeader
        
        ' 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
    
    ' Set freeze panes at the first date column (after the new columns)
    Dim freezeCol As Long
    If finalPositions.Exists("PM Report") Then
        freezeCol = finalPositions("PM Report") + 1
        wsNew.Activate
        wsNew.Cells(headerRow + 1, freezeCol).Select
        ActiveWindow.FreezePanes = False
        ActiveWindow.FreezePanes = True
    End If
    
    ' 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 & _
           "✓ Added blank separator column after PM Report" & vbCrLf & _
           "✓ Freeze panes set at first date column" & 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

' Check if a worksheet exists
Function WorksheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    WorksheetExists = Not ws Is Nothing
    On Error GoTo 0
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