Macro Enabled Excel - Run Time Error 1004

Hi All,


I am using a macro enabled excel file for the purpose of calculating certain accruals of income and depreciation on contracts. However I experienced a run time error 1004 -
Application – defined or object –defined error


This error has never occurred to the earlier users of the same macro. I do not understand if the source file from which the data is getting copied into the macro file is corrupt or not.

Find below the VB program code , I have highlighted the line where the error seems to occur when I clicked on the debug option. Would appreciate if anyone would be able to help me resolve it and also explain me in laymen terms what the issue is. I am from finance background with no knowledge about VB

Thanks alot for the support


ERROR is occuring with the below line

Range("hdrCount").Offset(1).Resize(rrData).PasteSpecial xlPasteFormulas

Option Explicit
Option Private Module


'***************************************************
'** Comments:   Adjust number of amortisation months
'
'** Arguments:  iAmortMonths        # months to be amortised
'
'** DATE        DEVELOPER           ACTION
'   25-Nov-10   Colin Burrows       Initial version
'
Public Sub AmortMonths(ByVal iAmortMonths As Integer)
    Dim cel             As Excel.Range
    Dim celLast         As Excel.Range
    Dim nnDelete        As Integer
    Dim nnDelta         As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   wksInput.Activate
    
    '** Delete any formulas below the input area
    Range("rngTranche").ClearContents
    
    '** Delete any Totals columns
    nnDelete = Range("TotalR").Column - Range("TotalL").Column - 1
    If nnDelete > 0 Then
        Range("TotalL").Offset(, 1).Resize(, nnDelete).EntireColumn.Delete
    End If
    
    '** Adjust # amortisation months
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    For Each cel In Range("GroupHeadings").SpecialCells(xlCellTypeConstants, xlTextValues)
    
        Set celLast = cel.Offset(1, 2).End(xlDown)
        nnDelta = iAmortMonths - celLast.Value
        
        If nnDelta < 0 Then
            celLast.Offset(nnDelta + 1).Resize(-nnDelta).EntireRow.Delete
            
        ElseIf nnDelta > 0 Then
            celLast.Offset(1).Resize(nnDelta).EntireRow.Insert
            celLast.Resize(1 + nnDelta).EntireRow.FillDown
            
        End If
    Next cel
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    
    '** Finish off
    Set cel = Nothing
    Set celLast = Nothing
    ActiveSheet.UsedRange
End Sub

'*************************************************
'** Comments:   Process the data on the 'Data' tab
'
'** Arguments:  None
'
'** DATE        DEVELOPER           ACTION
'   30-Nov-10   Colin Burrows       Initial version
'
Public Sub DataProcessing()
    Dim cel             As Range
    Dim nnMonths        As Long
    Dim rrData          As Long
    Dim rrDelete        As Long
    
    '** On the 'Data' tab copy down the formulas at the left and delete rows where all amounts are zero
    wksData.Activate
    rrData = Range("hdrDataType").CurrentRegion.Rows.Count - 1
    Range("flaLeft").Copy
    Range("hdrLeft").Offset(1).Resize(rrData).PasteSpecial xlPasteFormulas
    wksData.Calculate
    With Range("hdrLeft").CurrentRegion
        .Copy
        .PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Sort Key1:=.Cells(1, 1), Order1:=xlDescending, Header:=xlYes
    End With
    rrDelete = Range("rrDelete").Value
    If rrDelete > 0 Then
        Range("hdrLeft").Offset(1).Resize(rrDelete).EntireRow.Delete
        rrData = rrData - rrDelete
    End If
    
    '** Copy down the flaCount formula (used on the Accruals sheet)
    Range("flaCount").Copy
    Range("hdrCount").Offset(1).Resize(rrData).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
    
    '** Divide the amounts by a thousand (or whatever is stored in global range name 'Factor')
    With wksInput
        nnMonths = .Range("rowPymtEnd").Row - .Range("rowPymtTop").Row - 1
    End With
    Names("Factor").RefersToRange.Copy
    Range("hdr1p01").Offset(1).Resize(rrData, nnMonths).PasteSpecial xlPasteValues, xlPasteSpecialOperationDivide
    Application.CutCopyMode = False
    
    '** Separate out the EOL lines
    Range("hdrLeft").CurrentRegion.Sort Key1:=Range("hdrAccount"), Order1:=xlAscending, Header:=xlYes
    Range("hdrAccount").EntireColumn.Select
    On Error Resume Next
        Set cel = Selection.Find(What:="EOL", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, MatchCase:=True, SearchFormat:=False)
    On Error GoTo 0
    If Not cel Is Nothing Then
        cel.EntireRow.Insert
        Set cel = Nothing
    End If
    
    '** Sort into Co/Curr/Acct order
    Range("hdrLeft").CurrentRegion.Sort Header:=xlYes, _
        Key1:=Range("hdrSort").Cells(1, 1), Order1:=xlAscending, _
        Key2:=Range("hdrSort").Cells(1, 2), Order2:=xlAscending, _
        Key3:=Range("hdrSort").Cells(1, 3), Order3:=xlAscending
        
    Range("hdrDataType").Offset(1).Select
End Sub

'**************************************
'** Comments:   Inform user of progress
'
'** Arguments:  sMessage            Message to be displayed
'               iCall               Which call (first, next, last)
'               bDone               = True if 'Done' should terminate the message
'
'** DATE        DEVELOPER           ACTION
'   30-Dec-08   Colin Burrows       Initial version
'   20-Feb-09   Colin Burrows       Added iCall parameter
'   23-Nov-10   Colin Burrows       Added bDone parameter
'
Public Sub StatusMessage(Optional ByVal sMessage As String = vbNullString, _
                         Optional ByVal iCall As stsCall = stsMessage, _
                         Optional ByVal bDone As Boolean = True)
    Static frmStatus    As FStatus
    Static bCloseOut    As Boolean
    
    If iCall = stsLoad Then
        On Error Resume Next
            Unload frmStatus
            Set frmStatus = Nothing
        On Error GoTo 0
        Set frmStatus = New FStatus
        Load frmStatus
        With frmStatus
            .Caption = gsCAPTION
            .Show
            .Repaint
        End With
        bCloseOut = False
        
    ElseIf iCall = stsMessage Then
        With frmStatus
            If bCloseOut Then
                .lblStatus.Caption = .lblStatus.Caption & "  Done."
                .Repaint
            End If
            If .lblStatus.Caption = vbNullString Then
                .lblStatus.Caption = sMessage
            Else
                .lblStatus.Caption = .lblStatus.Caption & vbNewLine & vbNewLine & sMessage
            End If
            .Repaint
            bCloseOut = bDone
        End With
    
    ElseIf iCall = stsEllipsis Then
        With frmStatus
            .lblStatus.Caption = .lblStatus.Caption & "..."
            .Repaint
        End With
        bCloseOut = bDone
    
    ElseIf iCall = stsUnload Then
        Unload frmStatus
        Set frmStatus = Nothing
    End If
End Sub

attach your file

The only obvious things to check are 1) if the named range hdrCount exists and 2) what value does rrData have. Is the sheet you are copying to protected?

And, as Patel45 has suggested, maybe a good idea to upload a sample workbook that exhibits the problem.


Regards, TMS

Oh, and the other point is, it's hard to diagnose a run time error if you don't have the workbook and data that is producing it


Regards, TMS