Sub PMF_GanntBarBasic()
    Dim ws As Worksheet
    Dim headerRow As Long
    Dim dateRow As Long
    Dim startDateCol As Long
    Dim finishDateCol As Long
    Dim activityNameCol As Long
    Dim pmTypeCol As Long
    Dim resourceIDsCol As Long
    Dim currentRow As Long
    Dim startDate As Date
    Dim finishDate As Date
    Dim activityName As String
    Dim resourceName As String
    Dim resourceInitials As String
    Dim pmType As String
    Dim dateRange As Range
    Dim dateCell As Range
    Dim firstDate As Date
    Dim lastDate As Date
    Dim firstDateINT As Long
    Dim lastDateINT As Long
    Dim startDateINT As Long
    Dim finDateINT As Long
    Dim taskStart As Long
    Dim taskEnd As Long
    Dim cell As Range
    Dim col As Long
    Dim startCol As Long
    Dim endCol As Long
    
    ' Set the active worksheet
    Set ws = ActiveSheet
    
    ' Get the current row
    currentRow = ActiveCell.Row
    
    ' --- Find Header Row ---
    headerRow = FindHeaderRowAdvanced(ws)
    If headerRow = 0 Then
        MsgBox "Could not find header row with required columns.", vbCritical
        Exit Sub
    End If
    
    ' --- Find Date Timeline Row ---
    dateRow = FindDateTimelineRow(ws, headerRow)
    If dateRow = 0 Then
        MsgBox "Could not find date timeline row.", vbCritical
        Exit Sub
    End If
    
    ' --- Find Required Columns ---
    On Error Resume Next
    startDateCol = ws.Rows(headerRow).Find(What:="Start", LookIn:=xlValues, LookAt:=xlWhole).Column
    finishDateCol = ws.Rows(headerRow).Find(What:="Finish", LookIn:=xlValues, LookAt:=xlWhole).Column
    activityNameCol = ws.Rows(headerRow).Find(What:="Activity Name", LookIn:=xlValues, LookAt:=xlWhole).Column
    pmTypeCol = ws.Rows(headerRow).Find(What:="PM Type", LookIn:=xlValues, LookAt:=xlWhole).Column
    resourceIDsCol = ws.Rows(headerRow).Find(What:="Resource IDs", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    
    ' Check if required columns were found
    If startDateCol = 0 Or finishDateCol = 0 Or activityNameCol = 0 Or pmTypeCol = 0 Then
        MsgBox "Could not find required columns: Start, Finish, Activity Name, or PM Type in header row " & headerRow, vbCritical
        Exit Sub
    End If
    
    ' Handle Resource IDs column if not found
    If resourceIDsCol = 0 Then
        ' Try alternative column names
        On Error Resume Next
        resourceIDsCol = ws.Rows(headerRow).Find(What:="Resource", LookIn:=xlValues, LookAt:=xlPart).Column
        If resourceIDsCol = 0 Then
            resourceIDsCol = ws.Rows(headerRow).Find(What:="Resources", LookIn:=xlValues, LookAt:=xlPart).Column
        End If
        If resourceIDsCol = 0 Then
            resourceIDsCol = ws.Rows(headerRow).Find(What:="Resource ID", LookIn:=xlValues, LookAt:=xlPart).Column
        End If
        On Error GoTo 0
        
        If resourceIDsCol = 0 Then
            Dim inputCol As Variant
            inputCol = Application.InputBox("Resource column not found. Please enter the column number (e.g., 5 for column E), or click Cancel to skip:", "Resource Column", Type:=1)
            
            If IsNumeric(inputCol) And inputCol > 0 Then
                resourceIDsCol = CLng(inputCol)
            Else
                MsgBox "Resource initials will not be added.", vbInformation
                resourceIDsCol = 0
            End If
        End If
    End If
    
    ' --- Check PM Type ---
    pmType = Trim(ws.Cells(currentRow, pmTypeCol).Value)
    If pmType = "" Then
        MsgBox "PM Type is empty. No Gantt bar will be created.", vbInformation
        Exit Sub
    End If
    
    ' --- Get Task Data ---
    startDate = ws.Cells(currentRow, startDateCol).Value
    finishDate = ws.Cells(currentRow, finishDateCol).Value
    activityName = Trim(ws.Cells(currentRow, activityNameCol).Value)
    
    ' Get resource name and generate initials
    If resourceIDsCol > 0 Then
        resourceName = Trim(ws.Cells(currentRow, resourceIDsCol).Value)
        resourceInitials = GetResourceInitials(resourceName)
        
        ' Debug: Show what we found
        If resourceName <> "" Then
            Debug.Print "Resource Name found: '" & resourceName & "'"
            Debug.Print "Resource Initials: '" & resourceInitials & "'"
        Else
            Debug.Print "Resource Name is empty in column " & resourceIDsCol
        End If
    Else
        resourceInitials = ""
        Debug.Print "Resource column not found or skipped"
    End If
    
    ' --- Handle Missing Dates ---
    ' Check if start date is empty/blank
    If IsEmpty(ws.Cells(currentRow, startDateCol).Value) Or ws.Cells(currentRow, startDateCol).Value = "" Or Not IsDate(startDate) Then
        If IsDate(finishDate) Then
            startDate = finishDate ' IF start date = "" THEN Start date (var) = Finish date
        Else
            MsgBox "No valid start or finish date found in the current row.", vbExclamation
            Exit Sub
        End If
    End If
    
    ' Check if finish date is empty/blank  
    If IsEmpty(ws.Cells(currentRow, finishDateCol).Value) Or ws.Cells(currentRow, finishDateCol).Value = "" Or Not IsDate(finishDate) Then
        MsgBox "No valid finish date found in the current row.", vbExclamation
        Exit Sub
    End If
    
    ' --- Find Date Range and Get First/Last Dates ---
    Set dateRange = GetDateRange(ws, dateRow)
    If dateRange Is Nothing Then
        MsgBox "Could not find date range in timeline row.", vbCritical
        Exit Sub
    End If
    
    ' Get first and last dates from timeline
    firstDate = dateRange.Cells(1, 1).Value
    lastDate = dateRange.Cells(1, dateRange.Columns.Count).Value
    
    ' Convert to integers
    firstDateINT = CLng(firstDate)
    lastDateINT = CLng(lastDate)
    startDateINT = CLng(startDate)
    finDateINT = CLng(finishDate)
    
    ' --- Clip Dates to Timeline Boundaries ---
    If startDateINT < firstDateINT Then
        startDateINT = firstDateINT
    End If
    If finDateINT > lastDateINT Then
        finDateINT = lastDateINT
    End If
    
    ' --- Find Start and End Columns in Date Range ---
    startCol = 0
    endCol = 0
    
    For col = 1 To dateRange.Columns.Count
        If IsDate(dateRange.Cells(1, col).Value) Then
            If CLng(dateRange.Cells(1, col).Value) = startDateINT And startCol = 0 Then
                startCol = dateRange.Column + col - 1
            End If
            If CLng(dateRange.Cells(1, col).Value) = finDateINT Then
                endCol = dateRange.Column + col - 1
            End If
        End If
    Next col
    
    If startCol = 0 Or endCol = 0 Then
        MsgBox "Could not find start or end date in timeline. Task dates may be outside the timeline range.", vbExclamation
        Exit Sub
    End If
    
    ' --- Clean All Gantt Days from First to Last Dates ---
    ' First, identify weekend cells before clearing
    Dim weekendCells As Collection
    Set weekendCells = New Collection
    Dim tempCell As Range
    
    For Each tempCell In ws.Range(ws.Cells(currentRow, dateRange.Column), ws.Cells(currentRow, dateRange.Column + dateRange.Columns.Count - 1))
        Dim correspondingDateCol As Long
        correspondingDateCol = tempCell.Column - dateRange.Column + 1
        
        If correspondingDateCol <= dateRange.Columns.Count Then
            Dim dateValue As Variant
            dateValue = dateRange.Cells(1, correspondingDateCol).Value
            
            If IsDate(dateValue) Then
                Dim dayOfWeek As Integer
                dayOfWeek = Weekday(dateValue, vbSunday) ' 1=Sunday, 7=Saturday
                
                If dayOfWeek = 1 Or dayOfWeek = 7 Then ' Sunday or Saturday
                    weekendCells.Add tempCell.Address
                End If
            End If
        End If
    Next tempCell
    
    ' Clear existing formatting in the entire date range for this row
    For Each tempCell In ws.Range(ws.Cells(currentRow, dateRange.Column), ws.Cells(currentRow, dateRange.Column + dateRange.Columns.Count - 1))
        tempCell.Interior.ColorIndex = xlNone ' Clear background color
        tempCell.Value = "" ' Clear any text
    Next tempCell
    
    ' Restore weekend grey formatting
    Dim i As Integer
    For i = 1 To weekendCells.Count
        Set tempCell = ws.Range(weekendCells(i))
        tempCell.Interior.Color = RGB(192, 192, 192) ' Light grey for weekends
    Next i
    
    ' --- Create Gantt Bar ---
    ' Get the appropriate color based on PM Type
    Dim ganttColor As Long
    ganttColor = GetPMTypeColor(pmType)
    
    ' Fill cells with the determined color
    For Each cell In ws.Range(ws.Cells(currentRow, startCol), ws.Cells(currentRow, endCol))
        cell.Interior.Color = ganttColor
    Next cell
    
    ' Place activity name in start cell
    ws.Cells(currentRow, startCol).Value = activityName
    
    MsgBox "Gantt bar created successfully for: " & activityName, vbInformation
End Sub

' --- Helper Functions ---

Function FindHeaderRowAdvanced(ws As Worksheet) As Long
    Dim searchRange As Range
    Dim foundCell As Range
    Dim row As Long
    
    ' Search within the first 20 rows for any of the required headers
    Set searchRange = ws.Range("A1:ZZ20")
    
    ' Look for "Start" first (most likely to be unique)
    Set foundCell = searchRange.Find(What:="Start", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundCell Is Nothing Then
        row = foundCell.Row
        ' Verify other required columns exist in the same row
        On Error Resume Next
        If ws.Rows(row).Find(What:="Finish", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Or _
           ws.Rows(row).Find(What:="Activity Name", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Or _
           ws.Rows(row).Find(What:="PM Type", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
            row = 0 ' Not all required columns found
        End If
        On Error GoTo 0
    Else
        row = 0
    End If
    
    FindHeaderRowAdvanced = row
End Function

Function FindDateTimelineRow(ws As Worksheet, headerRow As Long) As Long
    Dim row As Long
    Dim col As Long
    Dim dateCount As Long
    Dim testRow As Long
    
    ' Search in rows around the header row (typically header+1 or header-1)
    For testRow = headerRow - 2 To headerRow + 5
        If testRow > 0 And testRow <= ws.Rows.Count Then
            dateCount = 0
            ' Count how many cells in this row contain dates
            For col = 1 To 100 ' Check first 100 columns
                If IsDate(ws.Cells(testRow, col).Value) Then
                    dateCount = dateCount + 1
                End If
                If dateCount >= 5 Then ' If we find 5+ dates, this is likely the date row
                    FindDateTimelineRow = testRow
                    Exit Function
                End If
            Next col
        End If
    Next testRow
    
    FindDateTimelineRow = 0 ' Not found
End Function

Function GetDateRange(ws As Worksheet, dateRow As Long) As Range
    Dim firstCol As Long
    Dim lastCol As Long
    Dim col As Long
    
    firstCol = 0
    lastCol = 0
    
    ' Find first and last columns containing dates
    For col = 1 To 1000 ' Check first 1000 columns
        If IsDate(ws.Cells(dateRow, col).Value) Then
            If firstCol = 0 Then firstCol = col
            lastCol = col
        End If
    Next col
    
    If firstCol > 0 And lastCol > 0 Then
        Set GetDateRange = ws.Range(ws.Cells(dateRow, firstCol), ws.Cells(dateRow, lastCol))
    Else
        Set GetDateRange = Nothing
    End If
End Function

Function GetPMTypeColor(pmType As String) As Long
    ' Clean and normalize PM Type using regex-like approach
    Dim pmTypeClean As String
    pmTypeClean = CleanPMType(pmType)
    
    ' Determine color based on PM Type
    If pmTypeClean = "BHP" Then
        GetPMTypeColor = RGB(255, 255, 0)    ' Yellow
    ElseIf pmTypeClean = "DOC" Then
        GetPMTypeColor = RGB(173, 216, 230)  ' Light Blue
    ElseIf pmTypeClean = "MS" Then
        GetPMTypeColor = RGB(255, 0, 0)      ' Red
    ElseIf pmTypeClean = "DWG" Then
        GetPMTypeColor = RGB(128, 0, 128)    ' Purple
    ElseIf pmTypeClean = "FAT" Then
        GetPMTypeColor = RGB(144, 238, 144)  ' Light Green
    ElseIf pmTypeClean = "SAT" Then
        GetPMTypeColor = RGB(0, 128, 128)    ' Dark Green/Teal
    ElseIf pmTypeClean = "SW" Then
        GetPMTypeColor = RGB(255, 255, 0)    ' Yellow
    Else
        GetPMTypeColor = RGB(0, 255, 0)      ' Default Green for any other value
    End If
End Function

Function CleanPMType(pmType As String) As String
    ' Comprehensive cleaning function - handles all whitespace scenarios
    Dim result As String
    Dim i As Integer
    Dim char As String
    
    ' Handle null/empty input
    If IsNull(pmType) Or pmType = "" Then
        CleanPMType = ""
        Exit Function
    End If
    
    ' Remove all leading and trailing whitespace characters
    ' This includes spaces, tabs, line feeds, carriage returns, etc.
    result = pmType
    
    ' Remove leading whitespace (spaces, tabs, etc.)
    Do While Len(result) > 0
        char = Left(result, 1)
        If char = " " Or char = vbTab Or char = vbCr Or char = vbLf Or Asc(char) = 160 Then ' 160 = non-breaking space
            result = Mid(result, 2)
        Else
            Exit Do
        End If
    Loop
    
    ' Remove trailing whitespace
    Do While Len(result) > 0
        char = Right(result, 1)
        If char = " " Or char = vbTab Or char = vbCr Or char = vbLf Or Asc(char) = 160 Then
            result = Left(result, Len(result) - 1)
        Else
            Exit Do
        End If
    Loop
    
    ' Convert to uppercase and return
    CleanPMType = UCase(result)
End Function

Function GetResourceInitials(resourceName As String) As String
    ' Extract initials from resource name using regex-like logic
    Dim initials As String
    Dim names() As String
    Dim i As Integer
    
    ' Debug output
    Debug.Print "GetResourceInitials called with: '" & resourceName & "'"
    
    ' Return empty if no resource name
    If Trim(resourceName) = "" Then
        Debug.Print "Resource name is empty, returning empty string"
        GetResourceInitials = ""
        Exit Function
    End If
    
    ' Clean the name - remove extra spaces and split by spaces
    resourceName = Trim(resourceName)
    ' Replace multiple spaces with single space
    Do While InStr(resourceName, "  ") > 0
        resourceName = Replace(resourceName, "  ", " ")
    Loop
    
    Debug.Print "Cleaned resource name: '" & resourceName & "'"
    
    ' Split by spaces
    names = Split(resourceName, " ")
    Debug.Print "Number of name parts: " & (UBound(names) + 1)
    
    ' Extract initials
    If UBound(names) = 0 Then
        ' Only one name (first name only)
        If Len(names(0)) > 0 Then
            initials = UCase(Left(names(0), 1))
            Debug.Print "Single name, initial: " & initials
        End If
    Else
        ' Multiple names - take first character of first and last name
        If Len(names(0)) > 0 Then
            initials = UCase(Left(names(0), 1))
            Debug.Print "First name initial: " & Left(initials, 1)
        End If
        If Len(names(UBound(names))) > 0 Then
            initials = initials & UCase(Left(names(UBound(names)), 1))
            Debug.Print "Last name initial: " & Right(initials, 1)
        End If
    End If
    
    ' Return in square brackets format
    If initials <> "" Then
        GetResourceInitials = "[" & initials & "]"
        Debug.Print "Final initials result: " & GetResourceInitials
    Else
        GetResourceInitials = ""
        Debug.Print "No initials generated"
    End If
End Function