Sub Clean_Data_And_Fix_And_Update()

Dim PayrollFile As Variant, fileName As String, eFilename As String, Path As

String, Psheet As Worksheet, img As Shape, lastCol As Long, i As Long, rng As
Range, header As Variant, col As Range, foundHeader As Range, grossSalaryCol As
Long, blankCellAddress As String
Dim projectDict As Object
Dim costPerProject As Double
Dim projects As Variant
Dim project As Variant
Dim lastRow As Long
Dim j As Long
Dim yearFolder As String, monthFolder As String, savePath As String
Dim monthName As String, dateTimeStamp As String
Dim fileYear As String, fileMonth As String

' Array for month names

Dim monthNames As Variant
monthNames = Array("January", "February", "March", "April", "May", "June",
"July", "August", "September", "October", "November", "December")

Set projectDict = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False
PayrollFile = Application.GetOpenFilename(Title:="Browse for your Payroll
File", fileFilter:="Excel Files (*.xls*),*xls*")
Select Case TypeName(PayrollFile)
Case "Boolean": MsgBox "No file selected. Exiting macro.": Exit Sub
Case Else
If PayrollFile = False Then MsgBox "File selection canceled. Exiting
macro.": Exit Sub
End Select
fileName = Mid(PayrollFile, InStrRev(PayrollFile, "\") + 1)
eFilename = Split(fileName, ".")(0)
Path = Left(PayrollFile, InStrRev(PayrollFile, "\"))

' Display the file name to understand its format

MsgBox "File Name: " & fileName

' Extract year and month from the file name

Dim yearPos As Integer, monthPos As Integer
Dim monthIndex As Integer
Dim monthFound As Boolean
monthFound = False

' Find the year (4 digits)

yearPos = InStr(fileName, "20") ' Assuming the year starts with "20"
If yearPos > 0 Then
fileYear = Mid(fileName, yearPos, 4)
Else
MsgBox "Year not found in file name. Exiting macro."
Exit Sub
End If

' Find the month (full month name)

For monthIndex = LBound(monthNames) To UBound(monthNames)
monthPos = InStr(fileName, monthNames(monthIndex))
If monthPos > 0 Then
fileMonth = monthNames(monthIndex)
monthFound = True
 Exit For
End If
Next monthIndex

If Not monthFound Then

MsgBox "Month not found in file name. Exiting macro."
Exit Sub
End If

' Display extracted year and month for debugging

MsgBox "Extracted Year: " & fileYear & vbCrLf & "Extracted Month: " & fileMonth

Workbooks.Open PayrollFile
Set Psheet = ActiveSheet

' Clean up the data

For Each rng In Psheet.UsedRange
If InStr(1, rng.Value, "pages", vbTextCompare) > 0 Then
rng.EntireRow.Delete
Next rng
Psheet.Cells.UnMerge
On Error Resume Next
ActiveSheet.Shapes.Range(Array("Picture 1")).Delete
On Error GoTo 0
Psheet.Cells.Interior.ColorIndex = xlNone
Psheet.Rows("1:4").Delete
lastCol = Psheet.Cells(1, Psheet.Columns.Count).End(xlToLeft).Column
For i = lastCol To 1 Step -1
Select Case Application.WorksheetFunction.CountA(Psheet.Columns(i))
Case 0: Psheet.Columns(i).Delete
End Select
Next i
header = Array("Basic", "Children Education Allowance", "Other Allowances",
"Welder Upgrade Allowance")
For Each headerItem In header
Set foundHeader = Psheet.Rows(3).Find(headerItem)
If Not foundHeader Is Nothing Then foundHeader.Value = "Fixed " &
foundHeader.Value
Next headerItem
For Each col In Psheet.Rows(3).Cells
Select Case col.Value
Case "": col.Value = col.Offset(-1, 0).Value
End Select
Next col
For Each col In Psheet.Rows(3).Cells
If col.Value = "" Then
col.Value = col.Offset(-1, 0).Value
If col.Column = lastCol Then blankCellAddress = col.Address
End If
Next col
Set foundHeader = Psheet.Rows(3).Find("Welder Upgrade Allowance")
If Not foundHeader Is Nothing Then foundHeader.Offset(0, 1).Value = "Gross
Salary": grossSalaryCol = foundHeader.Offset(0, 1).Column
Psheet.Columns(grossSalaryCol + 1).Resize(, 2).Delete
If Not Psheet.Rows(3).Find("Net Salary") Is Nothing Then
Set foundHeader = Psheet.Rows(3).Find("Net Salary")
If Not foundHeader Is Nothing Then foundHeader.Offset(, 1).Resize(,
2).Delete Shift:=xlToLeft
End If
 Range("A1").End(xlDown).End(xlToRight).Offset(0, 1).FillDown
Range("A1").End(xlDown).End(xlToRight).Offset(0, 1).FillDown
Psheet.Rows("1:2").Delete
ActiveSheet.Range(ActiveSheet.Range("A1"),
ActiveSheet.Range("A1").End(xlDown)).TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "General"
Psheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("A1").Select

' Add Sponsor column

Psheet.Cells(1, 3).EntireColumn.Insert
Psheet.Cells(1, 3).Value = "Sponsor Name"

' Ensure "Visa Entity" column remains correctly named

Psheet.Cells(1, 2).Value = "Visa Entity"

' Populate Sponsor column based on Visa Entity

lastRow = Psheet.Cells(Psheet.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
Select Case Psheet.Cells(i, 2).Value
Case "Personal", "EVSOFFWPS", "EVS Eng LLC", "DXB Golden Visa", "AD
Golden Visa"
Psheet.Cells(i, 3).Value = "Dubai"
Case "EVS FZE"
Psheet.Cells(i, 3).Value = "EVS FZE Visa"
Case "RAKMC"
Psheet.Cells(i, 3).Value = "RAKMC Visa"
Case Else
Psheet.Cells(i, 3).Value = ""
End Select
Next i

' Identify unique projects and create columns for them

Dim colIndex As Long
colIndex = Psheet.Rows(1).Find(What:="Projects-Sub Division", LookIn:=xlValues,
LookAt:=xlWhole).Column

For i = 2 To lastRow
projects = Split(Psheet.Cells(i, colIndex).Value, "/")
For Each project In projects
If Not projectDict.exists(project) Then
projectDict.Add project, True
Psheet.Cells(1, Psheet.Columns.Count).End(xlToLeft).Offset(0,
1).Value = project
End If
Next project
Next i

' Allocate costs to projects

Dim netSalaryCol As Long
netSalaryCol = Psheet.Rows(1).Find(What:="Net Salary Payable",
LookIn:=xlValues, LookAt:=xlWhole).Column

For i = 2 To lastRow
If IsNumeric(Psheet.Cells(i, netSalaryCol).Value) And Psheet.Cells(i,
5).Value <> 0 Then
 projects = Split(Psheet.Cells(i, colIndex).Value, "/")
costPerProject = Psheet.Cells(i, netSalaryCol).Value /
(UBound(projects) + 1)
For Each project In projects
For j = netSalaryCol To Psheet.Cells(1,
Psheet.Columns.Count).End(xlToLeft).Column
If Psheet.Cells(1, j).Value = project Then
Psheet.Cells(i, j).Value = costPerProject
End If
Next j
Next project
End If
Next i
' Find the "Name" column, go to the bottom of the data, offset by one row, and
delete that row
Set nameCol = Psheet.Rows(1).Find("Name", LookIn:=xlValues, LookAt:=xlWhole)
If Not nameCol Is Nothing Then
lastRow = Psheet.Cells(Psheet.Rows.Count, nameCol.Column).End(xlUp).Row
Psheet.Rows(lastRow + 1).Delete
End If

Set rng = Psheet.UsedRange

With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
rng.Columns.AutoFit

' Place the cursor in cell A1

Psheet.Range("A1").Select
Application.Goto Psheet.Range("A1"), True

' Enable AutoFilter

Psheet.UsedRange.AutoFilter

' Create folders and save the file using extracted year and month
yearFolder = fileYear
monthName = fileMonth ' Use the full month name extracted from the file name

savePath = Path & "Finance Reports\" & yearFolder & "\" & monthName & "\"

' Create the directories if they do not exist

If Dir(Path & "Finance Reports\", vbDirectory) = "" Then
MkDir Path & "Finance Reports\"
End If
If Dir(Path & "Finance Reports\" & yearFolder, vbDirectory) = "" Then
MkDir Path & "Finance Reports\" & yearFolder
End If
If Dir(Path & "Finance Reports\" & yearFolder & "\" & monthName, vbDirectory) =
"" Then
MkDir Path & "Finance Reports\" & yearFolder & "\" & monthName
End If

' Add datetime stamp to the file name

dateTimeStamp = Format(Now, "yyyy-mm-dd_hhmmss")

' Save the workbook with the datetime stamp

ActiveWorkbook.SaveAs fileName:=savePath & eFilename & "_Updated_" &
dateTimeStamp & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close

' Maximize the Excel window

Application.WindowState = xlMaximized

' Optional: Display a message box to confirm completion

MsgBox "Salary register updated and saved successfully in the same path in the
folder named Finance Reports"

Application.ScreenUpdating = True
End Sub