Option Explicit

Sub StandardizeColumnOrder()
    '=====================================================
    ' STANDARDIZE COLUMN ORDER MACRO
    ' Creates a new workbook with standardized column order
    ' Private and Confidential
    '=====================================================
    
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim wsNew As Worksheet
    Dim headerRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long, k As Long
    Dim found As Boolean
    Dim sourceCol As Long
    Dim targetCol As Long
    
    ' Define the standardized column order based on screenshot
    Dim standardColumns() As Variant
    standardColumns = Array( _
        "Activity ID", _
        "Activity Name", _
        "RTP Sites_A_code", _
        "Finish", _
        "Expected Finish", _
        "Late", _
        "Done", _
        "SOW", _
        "Network number", _
        "Comment", _
        "Progress update" _
    )
    
    ' Alternative column names to search for (handle variations)
    Dim altColumnNames As Object
    Set altColumnNames = CreateObject("Scripting.Dictionary")
    
    ' Add alternative names for columns that might have different labels
    altColumnNames.Add "RTP Sites_A_code", Array("RTP Sites_A_code", "RTP_Sites_A_code", "Sites_A_code", "BHP code", "Site Code")
    altColumnNames.Add "Late", Array("Late", "Variance - BL Project Finish Date", "Variance")
    altColumnNames.Add "Done", Array("Done", "Activity % Complete", "% Complete", "Complete")
    altColumnNames.Add "Network number", Array("Network number", "Network", "Network #", "Network No")
    altColumnNames.Add "Comment", Array("Comment", "Comments", "Notes")
    altColumnNames.Add "Progress update", Array("Progress update", "Progress", "Update", "Status")
    
    ' Set source worksheet (active sheet)
    Set wsSource = ActiveSheet
    
    ' Find header row by looking for "Activity ID"
    headerRow = 0
    found = False
    
    ' Search for "Activity ID" in first 20 rows
    For i = 1 To 20
        For j = 1 To 20
            If Not IsEmpty(wsSource.Cells(i, j).Value) Then
                If CleanString(CStr(wsSource.Cells(i, j).Value)) = "activityid" Then
                    headerRow = i
                    found = True
                    Exit For
                End If
            End If
        Next j
        If found Then Exit For
    Next i
    
    ' If not found, prompt user
    If headerRow = 0 Then
        Dim userInput As String
        userInput = InputBox("Could not find 'Activity ID' header." & vbCrLf & _
                           "Please enter the header row number:", _
                           "Header Row Input", "1")
        
        If userInput = "" Or Not IsNumeric(userInput) Then
            MsgBox "Invalid input. Operation cancelled.", vbExclamation
            Exit Sub
        End If
        
        headerRow = CLng(userInput)
        
        ' Validate the row number
        If headerRow < 1 Or headerRow > wsSource.Rows.Count Then
            MsgBox "Invalid row number. Operation cancelled.", vbExclamation
            Exit Sub
        End If
    End If
    
    ' Find last row and column with data
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    lastCol = wsSource.Cells(headerRow, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' Create new workbook
    Set wbNew = Workbooks.Add
    Set wsNew = wbNew.Sheets(1)
    wsNew.Name = "Standardized Data"
    
    ' Write headers to new sheet
    For i = 0 To UBound(standardColumns)
        wsNew.Cells(1, i + 1).Value = standardColumns(i)
    Next i
    
    ' Format headers
    With wsNew.Range(wsNew.Cells(1, 1), wsNew.Cells(1, UBound(standardColumns) + 1))
        .Font.Bold = True
        .Interior.ColorIndex = 35 ' Light green background
        .Borders.LineStyle = xlContinuous
    End With
    
    ' Copy data for each standardized column
    For targetCol = 0 To UBound(standardColumns)
        sourceCol = 0
        found = False
        
        ' First try exact match
        For j = 1 To lastCol
            If Not IsEmpty(wsSource.Cells(headerRow, j).Value) Then
                If CleanString(CStr(wsSource.Cells(headerRow, j).Value)) = _
                   CleanString(CStr(standardColumns(targetCol))) Then
                    sourceCol = j
                    found = True
                    Exit For
                End If
            End If
        Next j
        
        ' If not found and alternatives exist, try alternative names
        If Not found And altColumnNames.Exists(standardColumns(targetCol)) Then
            Dim altNames As Variant
            altNames = altColumnNames(standardColumns(targetCol))
            
            For k = 0 To UBound(altNames)
                For j = 1 To lastCol
                    If Not IsEmpty(wsSource.Cells(headerRow, j).Value) Then
                        If CleanString(CStr(wsSource.Cells(headerRow, j).Value)) = _
                           CleanString(CStr(altNames(k))) Then
                            sourceCol = j
                            found = True
                            Exit For
                        End If
                    End If
                Next j
                If found Then Exit For
            Next k
        End If
        
        ' Copy data if column was found
        If found And sourceCol > 0 Then
            ' Copy column data
            For i = headerRow + 1 To lastRow
                wsNew.Cells(i - headerRow + 1, targetCol + 1).Value = _
                    wsSource.Cells(i, sourceCol).Value
            Next i
            
            ' Color code to show data was found (optional)
            wsNew.Cells(1, targetCol + 1).Interior.ColorIndex = 35 ' Green
        Else
            ' Column not found - mark header in yellow
            wsNew.Cells(1, targetCol + 1).Interior.ColorIndex = 6 ' Yellow
            
            ' Add note about missing column
            wsNew.Cells(1, targetCol + 1).AddComment
            wsNew.Cells(1, targetCol + 1).Comment.Text "Column not found in source data"
        End If
    Next targetCol
    
    ' Auto-fit columns
    wsNew.Columns.AutoFit
    
    ' Apply borders to data range
    Dim dataRange As Range
    Set dataRange = wsNew.Range(wsNew.Cells(1, 1), _
                                wsNew.Cells(lastRow - headerRow + 1, UBound(standardColumns) + 1))
    dataRange.Borders.LineStyle = xlContinuous
    
    ' Save the new workbook
    Dim savePath As String
    savePath = Application.GetSaveAsFilename( _
        InitialFileName:="Standardised Column Order.xlsm", _
        FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", _
        Title:="Save Standardized Column Order File")
    
    If savePath <> "False" Then
        Application.DisplayAlerts = False
        wbNew.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True
        
        MsgBox "Standardized column order file created successfully!" & vbCrLf & _
               "Saved as: " & savePath & vbCrLf & vbCrLf & _
               "Green headers = Data found and copied" & vbCrLf & _
               "Yellow headers = Column not found in source", _
               vbInformation, "Success"
    Else
        MsgBox "Save cancelled. The new workbook remains open.", vbInformation
    End If
    
End Sub

Function CleanString(inputStr As String) As String
    '=====================================================
    ' Clean string using regex pattern
    ' Removes whitespace and non-alphanumeric characters
    ' Converts to lowercase for comparison
    '=====================================================
    
    Dim regex As Object
    Dim cleanStr As String
    
    ' Create regex object
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .IgnoreCase = True
        .Pattern = "[^a-zA-Z0-9]" ' Remove everything except letters and numbers
    End With
    
    ' Remove non-alphanumeric characters
    cleanStr = regex.Replace(inputStr, "")
    
    ' Convert to lowercase for comparison
    CleanString = LCase(cleanStr)
    
    Set regex = Nothing
End Function

Sub TestCleanString()
    '=====================================================
    ' Test function to verify string cleaning
    '=====================================================
    
    Debug.Print "Original: 'Activity ID' -> Cleaned: '" & CleanString("Activity ID") & "'"
    Debug.Print "Original: ' Activity ID  ' -> Cleaned: '" & CleanString(" Activity ID  ") & "'"
    Debug.Print "Original: 'Activity_ID' -> Cleaned: '" & CleanString("Activity_ID") & "'"
    Debug.Print "Original: 'Activity-ID!!' -> Cleaned: '" & CleanString("Activity-ID!!") & "'"
    
End Sub

Sub ShowSourceColumns()
    '=====================================================
    ' Helper function to display all column headers in source
    ' Useful for debugging and mapping
    '=====================================================
    
    Dim ws As Worksheet
    Dim headerRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim msg As String
    
    Set ws = ActiveSheet
    
    ' Try to find header row
    headerRow = 1 ' Default
    For i = 1 To 20
        If Not IsEmpty(ws.Cells(i, 1).Value) Then
            If InStr(1, ws.Cells(i, 1).Value, "Activity", vbTextCompare) > 0 Then
                headerRow = i
                Exit For
            End If
        End If
    Next i
    
    lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column
    
    msg = "Column headers found in row " & headerRow & ":" & vbCrLf & vbCrLf
    
    For i = 1 To lastCol
        If Not IsEmpty(ws.Cells(headerRow, i).Value) Then
            msg = msg & "Column " & i & ": " & ws.Cells(headerRow, i).Value & vbCrLf
        End If
    Next i
    
    MsgBox msg, vbInformation, "Source Column Headers"
    
End Sub