Application-defined or object-defined macro error

August 26, 2015 at 07:11:08
Specs: Windows XP
I have a few macros in my workbook that are very similar and which seem to only reference different sheets. When I run one it works fine, but the other gives me the "Application-defined or object-defined error" Below are my two macros. The first one is the one I receive an error on and the second one runs fine. Why am I getting an error when they are seemingly identical?

Sub Mobility_Initialize()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
Dim newsheet
    
    Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    newsheet.Name = "Temp"
        
    Sheets("Mobility").Range("A1:J1").Copy Sheets("Temp").Range("A1")
'Determine Number of Rows in Sheet1 Column A
    numRows = Sheets("Mobility").Range("A" & Rows.Count).End(xlUp).Row
'Get 10% of that number
    percRows = numRows * 0.1
    If percRows < 1 Then percRows = 1
'Allocate elements in Array
    ReDim MyRows(percRows)
'Create Random numbers and fill array
     For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
       
     Sheets("Mobility").Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets("Temp").Cells(copyRow, 1).Offset(1)
     
  Next
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    
            Columns("A:J").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
        Range("A1:J1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Columns("K:O").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Activate
     
    If ActiveSheet.Range("A2").Value = "NOMEN" Then Call Null_Value_Cleanup

    Call Initialize_Report
    End Sub


Here is the one that runs fine.

Sub N7_Initialize()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
Dim newsheet
    
    Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    newsheet.Name = "Temp"
        
    Sheets("N7").Range("A1:J1").Copy Sheets("Temp").Range("A1")
'Determine Number of Rows in Sheet1 Column A
    numRows = Sheets("N7").Range("B" & Rows.Count).End(xlUp).Row
'Get 10% of that number
    percRows = numRows * 0.1
    If percRows < 1 Then percRows = 1
    'percRows = ThisWorkbook.Sheets("Controls").Range("AA1")
'Allocate elements in Array
    ReDim MyRows(percRows)
'Create Random numbers and fill array
     For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
       
     Sheets("N7").Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets("Temp").Cells(copyRow, 1).Offset(1)
     
  Next
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    
            Columns("A:J").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
        Range("A1:J1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        
            Last = Cells(Rows.Count, "K").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "K").Value) = "LAST TRANSACTION" Then
    'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
    
    Columns("K:O").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Activate
     
    If ActiveSheet.Range("A2").Value = "NOMEN" Then Call Null_Value_Cleanup

    Call Initialize_Report
    End Sub

message edited by JasonB


See More: Application-defined or object-defined macro error

Report •


#1
August 26, 2015 at 08:24:10
It would help if you could tell us what instruction is producing the error.

If you are not getting a dialog box allowing you to choose Debug to highlight the offending instruction, please refer to the Single Step Debugging technique described in the following tutorial. Single Step through the code via F8 and keep track of which instruction causes the error and let us know.

In fact, you may even be able to answer your own question by using the debugging techniques from the tutorial. Let us know.

http://www.computing.net/howtos/sho...


message edited by DerbyDad03


Report •

#2
August 26, 2015 at 08:42:28
This section is producing the error.

     Sheets("Mobility").Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets("Temp").Cells(copyRow, 1).Offset(1)


Report •

#3
August 26, 2015 at 12:58:50
I am not having any problems with that instruction. Without a copy of your workbook, there's is not much I can offer.

I created a simple sheet with some data in Column A and the code ran just fine.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions


Ask Question