none
Run time error 1004 Application – defined or object –defined error RRS feed

  • Question

  • Hi All,

    I have a query regarding a run time error 1004 Application – defined or object –defined error I get each time I run the file. When the run time error window pops up , I click on debug option and the following line in the VB code gets highlighted in yellow. Kindly help me resolve this error as I am not knowledgeable about Visual basics. Would be really greatfull if someone would be able to help me out

        '** Copy down the flaCount formula (used on the Accruals sheet)

        Range("flaCount").Copy

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

        Application.CutCopyMode = False

    The full code is as below:-

    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


    Tuesday, March 19, 2013 5:44 PM

All replies

  • Hover your mouse over rrData when you get that error and examine what the value is in the pop-up. It must be >0 or else the code will fail.

    I think you probably made an error here:

        If rrDelete > 0 Then

            Range("hdrLeft").Offset(1).Resize(rrDelete).EntireRow.Delete

            rrData = rrData - rrDelete

        End If

    If rrDelete is > rrData, rrData becomes negative. It is impossible to figure it out for sure without the workbook.


    Tuesday, March 19, 2013 6:20 PM