+ Reply to Thread
Results 1 to 3 of 3

Excel VBA Runtime 1004 Error

Hybrid View

  1. #1
    Registered User
    Join Date
    08-07-2012
    Location
    Minneapolis, MN
    MS-Off Ver
    Excel 2010
    Posts
    2

    Excel VBA Runtime 1004 Error

    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

  2. #2
    Registered User
    Join Date
    08-07-2012
    Location
    Minneapolis, MN
    MS-Off Ver
    Excel 2010
    Posts
    2

    Re: Excel VBA Runtime 1004 Error

    Disregard. Was able to figure it out. One of the field's values started with an "=" which must have thrown off the code. Once I removed it, it ran successfully.

  3. #3
    Forum Contributor bonny24tycoon's Avatar
    Join Date
    04-02-2012
    Location
    Hell
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    405

    Re: Excel VBA Runtime 1004 Error

    If your issue has been resolved, can you mark this thread as solved?
    Thanks,

    Bonny Tycoon


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1