ProcessProlificData

Sub ProcessProlificData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Application.ScreenUpdating = False

    ' Get source worksheet
    Set wsSource = ActiveSheet

    ' Create new worksheet
    Set wsTarget = ThisWorkbook.Sheets.Add(After:=wsSource)
    wsTarget.Name = "Processed_Data"

    ' Copy original data
    wsSource.UsedRange.Copy wsTarget.Range("A1")
    lastRow = wsTarget.Cells(wsTarget.Rows.count, "A").End(xlUp).row

    ' Add new column headers
    With wsTarget
        .Cells(1, 9).Value = "Duration"
        .Cells(1, 10).Value = "Reward (£)"
        .Cells(1, 11).Value = "Reward ($)"
        .Cells(1, 12).Value = "Bonus (£)"
        .Cells(1, 13).Value = "Bonus ($)"
        .Cells(1, 14).Value = "Year"
        .Cells(1, 15).Value = "Month"
    End With

    ' Process each row
    For i = 2 To lastRow
        ' Process dates and calculate duration
        If Not IsEmpty(wsTarget.Cells(i, 4)) And Not IsEmpty(wsTarget.Cells(i, 5)) Then
            wsTarget.Cells(i, 9).Value = wsTarget.Cells(i, 5).Value - wsTarget.Cells(i, 4).Value
        End If

        ' Process Reward
        Dim rewardText As String
        rewardText = Trim(wsTarget.Cells(i, 2).Value)

        If Left(rewardText, 1) = "$" Then
            wsTarget.Cells(i, 11).Value = CDbl(Mid(rewardText, 2))  ' USD column
            wsTarget.Cells(i, 10).Value = ""  ' Clear GBP column
        ElseIf Left(rewardText, 1) = "£" Then
            wsTarget.Cells(i, 10).Value = CDbl(Mid(rewardText, 2))  ' GBP column
            wsTarget.Cells(i, 11).Value = ""  ' Clear USD column
        End If

        ' Process Bonus
        Dim bonusText As String
        bonusText = Trim(wsTarget.Cells(i, 3).Value)

        If Left(bonusText, 1) = "$" Then
            wsTarget.Cells(i, 13).Value = CDbl(Mid(bonusText, 2))  ' USD column
            wsTarget.Cells(i, 12).Value = ""  ' Clear GBP column
        ElseIf Left(bonusText, 1) = "£" Then
            wsTarget.Cells(i, 12).Value = CDbl(Mid(bonusText, 2))  ' GBP column
            wsTarget.Cells(i, 13).Value = ""  ' Clear USD column
        End If

        ' Extract Year and Month
        If Not IsEmpty(wsTarget.Cells(i, 4)) Then
            wsTarget.Cells(i, 14).Value = Year(wsTarget.Cells(i, 4))
            wsTarget.Cells(i, 15).Value = Month(wsTarget.Cells(i, 4))
        End If
    Next i

    ' Format columns
    With wsTarget
        .Range("I:I").NumberFormat = "[h]:mm:ss"
        .Range("J:J").NumberFormat = "[$£-en-GB]#,##0.00;-[$£-en-GB]#,##0.00;;@"  ' GBP Reward
        .Range("K:K").NumberFormat = "[$$-en-US]#,##0.00;-[$$-en-US]#,##0.00;;@"  ' USD Reward
        .Range("L:L").NumberFormat = "[$£-en-GB]#,##0.00;-[$£-en-GB]#,##0.00;;@"  ' GBP Bonus
        .Range("M:M").NumberFormat = "[$$-en-US]#,##0.00;-[$$-en-US]#,##0.00;;@"  ' USD Bonus
        .Range("N:O").NumberFormat = "0"  ' Year and Month
    End With

    ' Add conditional formatting for Status column
    With wsTarget.Range("G2:G" & lastRow)
        .FormatConditions.Delete
        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""APPROVED""")
            .Interior.Color = RGB(198, 239, 206)  ' Light green
        End With
        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""RETURNED""")
            .Interior.Color = RGB(173, 216, 230)  ' Light blue
        End With
        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""AWAITING REVIEW""")
            .Interior.Color = RGB(255, 165, 0)  ' Light orange
        End With
        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""REJECTED""")
            .Interior.Color = RGB(216, 54, 0)  ' Light red
        End With
    End With

    ' Reorganize columns as per Macro3
    With wsTarget
        .Columns("B:C").Delete Shift:=xlToLeft
        .Columns("H:H").Cut
        .Columns("B:B").Insert Shift:=xlToRight
        .Columns("J:J").Cut
        .Columns("C:C").Insert Shift:=xlToRight
        .Columns("J:J").Cut
        .Columns("D:D").Insert Shift:=xlToRight
        .Columns("K:K").Cut
        .Columns("E:E").Insert Shift:=xlToRight
        .Columns("K:K").Cut
        .Columns("H:H").Insert Shift:=xlToRight
        .Columns("B:E").ColumnWidth = 12
    End With

    ' Set other column widths
    wsTarget.Columns("A").AutoFit    ' Study title
    wsTarget.Columns("F:M").AutoFit  ' All other columns

    ' Delete Sheet1 if it exists
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Application.ScreenUpdating = True
End Sub