Application Defined or Object defined error

bennyamy · #1 03-22-2017, 08:57 AM

I have the below coding and the first "ar" range copy works perfectly.
I added the "mr" & "nr" so it could paste down the blank rows below the cells are non blank, basically copy & paste down. I get the error on code line:

Code:

mr(0).Copy mr

I also attached a copy of the spreadsheet with the correct results in column C (ar)
What am I missing?

Code:

Dim rng As Range, ar As Range
Dim nr As Range
Dim mr As Range

Set rng = Columns(3).SpecialCells(xlBlanks)
For Each ar In rng.Areas
ar(0).Copy ar
Next
      
Set rng = Columns(13).SpecialCells(xlBlanks)
For Each mr In rng.Areas
mr(0).Copy mr
Next

Set rng = Columns(14).SpecialCells(xlBlanks)
For Each nr In rng.Areas
nr(0).Copy nr
Next

NoSparks · #2 03-22-2017, 02:06 PM

I can't really explain the error, but by suppressing error messages for that part of the code I believe what you're wanting to happen does happen.

Code:

On Error Resume Next

Set rng = Columns(3).SpecialCells(xlBlanks)
For Each ar In rng.Areas
ar(0).Copy ar
Next
      
Set rng = Columns(13).SpecialCells(xlBlanks)
For Each mr In rng.Areas
mr(0).Copy mr
Next

Set rng = Columns(14).SpecialCells(xlBlanks)
For Each nr In rng.Areas
nr(0).Copy nr
Next

On Error GoTo 0

Your code after that seems to have an issue but I don't know what you're trying to do.
Toggle a break point at the start of the While loop and F8 through the code to see if what you're expecting to be selected is actually what's being selected.

bennyamy · #3 03-23-2017, 08:26 AM

Yeah, you were right it was the next part of my script.
How would I go about cutting and pasting the data in column I of the attached spreadsheet to a certain number of rows below where the data is now?

So the numbers in column I would need to be pasted the number of rows shown in column N. For example for I13 the number 2 would need to move down 2 rows in the same column, same for I10 move down to I12 and so on.

Here is my entire script, everything works perfectly just need that last step to complete it.

Code:

Sub AddingRows()
Dim LR As Long
Dim n As Integer
Dim temp As Long
Dim rng As Range, ar As Range
Dim nr As Range
Dim mr As Range



'Column E
'PO Number
    Sheets("Data").Select
    Columns("B:H").Select
    Selection.Copy
    Sheets("WinShuttleUpload (2)").Select
    Columns("C:C").Select
    ActiveSheet.Paste
    Range("D2").Select
LR = ActiveSheet.UsedRange.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Range("M2").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(C[-10],RC[-10])"
        Range("M2").AutoFill Destination:=Range("M2:M" & LR)
        Range("M:M").Select
        
     Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-11]=R[-1]C[-11],R[-1],IF(RC[-1]>0,RC[-1]+1))"
         Range("N2").AutoFill Destination:=Range("N2:N" & LR)
    Range("N:N").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
LR = ActiveSheet.Range("C" & Rows.count).End(xlUp).Row
        

While LR > 0
  If ActiveSheet.Range("C" & LR).Value <> ActiveSheet.Range("C" & LR + 1) Then
    Dim NewRows As Long:    NewRows = ActiveSheet.Range("N" & LR).Value
    Dim InsertIndex As Long:        InsertIndex = 1
    While InsertIndex <= NewRows
        ActiveSheet.Range("N" & LR + 1).EntireRow.Insert
        InsertIndex = InsertIndex + 1
    Wend
   End If
   LR = LR - 1
Wend

Range("G3:H3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next

Set rng = Columns(3).SpecialCells(xlBlanks)
For Each ar In rng.Areas
ar(0).Copy ar
Next
      
Set rng = Columns(13).SpecialCells(xlBlanks)
For Each mr In rng.Areas
mr(0).Copy mr
Next

Set rng = Columns(14).SpecialCells(xlBlanks)
For Each nr In rng.Areas
nr(0).Copy nr
Next

On Error GoTo 0



      
End Sub

NoSparks · #4 03-23-2017, 09:51 AM

I don't understand what you're trying to do and I have a real problem with activecells and selects,
maybe something like this ?

Code:

Dim lr As Long, x As Long

With Sheets("WinShuttleUpload (2)")
    lr = .Cells(Rows.Count, "I").End(xlUp).Row
    For x = lr To 3 Step -1
        If .Cells(x, "I") <> "" Then
            .Cells(x + .Range("N" & x).Value, "I").Value = .Cells(x, "I").Value
            .Cells(x, "I").ClearContents
        End If
    Next x
End With

bennyamy · #5 03-23-2017, 11:42 AM

Quote:

Originally Posted by NoSparks

I don't understand what you're trying to do and I have a real problem with activecells and selects,
maybe something like this ?

Code:

Dim lr As Long, x As Long

With Sheets("WinShuttleUpload (2)")
    lr = .Cells(Rows.Count, "I").End(xlUp).Row
    For x = lr To 3 Step -1
        If .Cells(x, "I") <> "" Then
            .Cells(x + .Range("N" & x).Value, "I").Value = .Cells(x, "I").Value
            .Cells(x, "I").ClearContents
        End If
    Next x
End With

That worked perfectly. Thanks!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
FileSystemObject Compile Error: User-Defined Type Not Defined	gsrikanth	Excel Programming	2	03-28-2022 06:32 AM
User-defined Type not Defined VBA Issue	OTPM	Project	3	01-02-2014 01:47 PM
Range.Information(wdStartOfRangeRowNumber): Application-defined or Object-defined err	tinfanide	Excel Programming	2	06-09-2012 10:19 AM
Application-defined or Object-defined error	Manit	Excel Programming	4	12-08-2011 07:35 PM
Compile error: sub or function not defined..	xena2305	Excel Programming	0	08-02-2011 10:17 AM