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
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
Code:
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 SubCode:
'*************************************************
'** 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 SubCode:
'**************************************
'** 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