Hello everyone,

Running into issues with a 1004 runtime error. I've used this code for several months without issue. This past month my customer added a few new columns to their report. I updated the code to delete them accordingly. I've tried adding these columns to a previous report and it runs fine. Something specific with the file?

Errors out on the following line: Sheets(1).Range("A1:O" & DestRow).Value = DestArray.

Any help would be greatly appreciated.

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