Sub Clean_Data_And_Fix()
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
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, "\"))
Workbooks.Open PayrollFile
Set Psheet = ActiveSheet
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
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
Application.ScreenUpdating = True
End Sub
