Sub Macro1()
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationManual
Range("A:D").Delete
Range("G:G").Delete
Range("P:AP").Delete
Range("A:A").Delete
Range("D:D").Delete
Range("A1").Select
ActiveCell.EntireRow.Insert
Range("A1:C1").Value = "A"
Range("D1").Value = "Apply Completed"
Range("E1").Value = "Apply Completed"
Range("F1").Value = "Interviewed"
Range("G1").Value = "Qualified"
Range("H1").Value = "Interviewed"
Range("I1").Value = "Interviewed"
Range("J1").Value = "Interviewed"
Range("K1").Value = "Offer Made"
Range("L1").Value = "Offer Made"
Range("M1").Value = "Hired"
Dim LastRow
LastRow = Range("A200000").End(xlUp).Row
Dim CurRow
CurRow = 3
Dim CurCol
CurCol = 4
Dim DestRow
DestRow = 2
Dim SourceArray As Variant
SourceArray = Sheets(1).Range("A1:M" & LastRow)
Dim DestArray As Variant
ReDim DestArray(1 To 200000, 1 To 15)
DestArray(1, 1) = SourceArray(2, 1)
DestArray(1, 2) = SourceArray(2, 2)
DestArray(1, 3) = SourceArray(2, 3)
DestArray(1, 4) = SourceArray(2, 4)
DestArray(1, 5) = SourceArray(2, 5)
DestArray(1, 6) = SourceArray(2, 6)
DestArray(1, 7) = SourceArray(2, 7)
DestArray(1, 8) = SourceArray(2, 8)
DestArray(1, 9) = SourceArray(2, 9)
DestArray(1, 10) = SourceArray(2, 10)
DestArray(1, 11) = SourceArray(2, 11)
DestArray(1, 12) = SourceArray(2, 12)
DestArray(1, 13) = SourceArray(2, 13)
For CurRow = 3 To LastRow
For CurCol = 4 To 13
If SourceArray(CurRow, CurCol) <> "" Then
DestArray(DestRow, 1) = SourceArray(CurRow, 1)
DestArray(DestRow, 2) = SourceArray(CurRow, 2)
DestArray(DestRow, 3) = SourceArray(CurRow, 3)
DestArray(DestRow, 4) = SourceArray(CurRow, 4)
DestArray(DestRow, 5) = SourceArray(CurRow, 5)
DestArray(DestRow, 6) = SourceArray(CurRow, 6)
DestArray(DestRow, 7) = SourceArray(CurRow, 7)
DestArray(DestRow, 8) = SourceArray(CurRow, 8)
DestArray(DestRow, 9) = SourceArray(CurRow, 9)
DestArray(DestRow, 10) = SourceArray(CurRow, 10)
DestArray(DestRow, 11) = SourceArray(CurRow, 11)
DestArray(DestRow, 12) = SourceArray(CurRow, 12)
DestArray(DestRow, 13) = SourceArray(CurRow, 13)
DestArray(DestRow, 14) = SourceArray(CurRow, CurCol)
DestArray(DestRow, 15) = SourceArray(1, CurCol)
DestRow = DestRow + 1
Else
End If
Next CurCol
Next CurRow
Sheets(1).Range("A1:O" & DestRow).Value = DestArray
Range("A1").Select
ActiveCell.EntireColumn.Insert
Range("D:D").Cut Destination:=Range("A:A")
Range("B1").Select
ActiveCell.EntireColumn.Insert
Range("Q:Q").Cut Destination:=Range("B:B")
Range("C1").Select
ActiveCell.EntireColumn.Insert
Range("Q:Q").Cut Destination:=Range("C:C")
Range("F1").Select
ActiveCell.EntireColumn.Insert
Range("A1").Value = "Email"
Range("B1").Value = "Status"
Range("C1").Value = "Date"
Range("D1").Value = "JobID1"
Range("E1").Value = "Title"
Range("F1").Value = "J2wMemberID"
Range("G1").Value = "ClientApplicantID"
Range("H:Q").Delete
Range("H2:H" & DestRow).Formula = Range("C2:C" & DestRow).Value2
Range("H2:H" & DestRow).Select
Selection.Copy
Range("C2:C" & DestRow).Select
Selection.PasteSpecial Paste:=xlPasteValues
With Range("H2:H" & DestRow)
.Value = Evaluate("IF(ROW(" & .Address & "),ROUNDDOWN(" & .Address & ",0))")
.NumberFormat = "0"
End With
Range("H2:H" & DestRow).Select
Selection.Copy
Range("C2:C" & DestRow).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("H2:H" & DestRow).Delete
Range("C2:C" & DestRow).NumberFormat = "mm-dd-yyyy"
Sheets(1).Range("A1:G" & DestRow).Font.Size = 10
Sheets(1).Range("A1:G" & DestRow).Font.Name = "Arial"
Sheets(1).Range("A1:G1").Font.Color = vbBlack
Sheets(1).Range("A1:G1").Font.Bold = True
Sheets(1).Range("A1:G1").Interior.Color = vbYellow
Range("A1:G" & DestRow).Borders.Weight = xlThin
Range("A1:G" & DestRow).Borders.ColorIndex = xlAutomatic
ActiveSheet.UsedRange.Columns.AutoFit
Sheets(1).Name = "Sheet1"
Dim ws As Worksheet
For Each ws In Sheets
Application.DisplayAlerts = False
If ws.Name <> "Sheet1" Then ws.Delete
Next
Application.DisplayAlerts = True
Range("I2:I" & LastRow).Formula = "=IF(DATE(YEAR(C2),MONTH(C2),DAY(C2))>DATE(2012,12,31),1,0)"
Range("I1").Formula = "=SUM(I2:I" & LastRow & ")"
Dim FutureDate As Integer
FutureDate = Range("I1").Value
Range("I:I").Delete
If FutureDate > 0 Then
MsgBox "This file contains records with dates greater than the current year."
Range("A2:H" & LastRow).Sort Key1:=Range("C2:C" & LastRow), order1:=xlDescending
Else
End If
Application.StatusBar = False
Application.ScreenUpdating = True
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
End Sub
Bookmarks