Application definition or object definition error

Question

Hello. I am trying to format a table to base a graph, however I am getting the following error message: "run-time error ? 1004': error defined by the application or defined by the object"

I am using the following macro. Does anything know the reason for the error? The error occurs on the line >>><<<

Sub Botão_ReplicadorColuna()

Dim i, j, UltimaLinha, UltimaColuna As Long

UltimaLinha = 1000000
UltimaColuna = 30

Application.ScreenUpdating = False
For j = 4 To UltimaColuna
    For i = UltimaLinha To 1 Step -1
        If Cells(i, j).Value <> "" Then
           Cells(i + 1, 2).EntireRow.Insert
           Cells(i + 1, 1).Value = Cells(i, 1).Value
           >>>>Cells(i + 1, 2).Value = Cells(i, 2).Value<<<<
           Cells(i + 1, 3).Value = Cells(i, j).Value
           Cells(i, j).Value = ClearContents
        End If
    Next
Next

Application.ScreenUpdating = True
Range("A1").Select


End Sub

I have two spreadsheets. One in which the macro is and the other in which I did a data processing and then copied it and pasted in the macro spreadsheet.

There are no mixed cells.

I could notice that up to 100000 lines the macro works perfectly. After that it presents the error.

What I wish to do is this. I want to replicate the id and content for each existing theme column so that a row is made up of only three columns.

    **Original:**
    ID / Content / Theme
    1 / words / theme/ theme2/ theme3
    2 / words / theme/ them2
    3 / words / theme

    **Pós-macro:**
    ID / Content / Theme
    1 / words / theme
    1 / words / theme2
    1 / words / theme3
    2 / words / theme
    2 / words / theme2
    3 / words / theme

Answer 1

I tested and the code worked for me with a few lines. Then I will list below changes in the code and some observations of what may be happening.

Loop

If the data is this way:

  1   words   theme   theme2   theme3  
  2   words   theme                    
  3   words   theme   them2   

The code no longer works...

Then I suggest reversing the loop to:

For i = 1 To UltimaLinha
    For j = UltimaColuna To 4 Step -1
    Next j
Next i

Statement

The statement is incorrect in this way:

Dim i, j, UltimaLinha, UltimaColuna As Long

In which i, j, UltimaLinha are declared only as Variant and UltimaColuna as Long. The right thing would be:

Dim i As Long, j As Long, UltimaLinha As Long, UltimaColuna As Long

(Strange syntax that occurs in VBA) What is not a problem, because then they are transformed to Long, but it is better not to let the VBA "find out" what type of variable will be used.

Line Boundary

I don’t know the amount of data in the spreadsheet, but Excel has a limit of 1 048 576 lines, so when it reaches the 100,000 line it may be trying to insert a line and there is no more space. Check if this amount of lines is being exceeded.

Worksheet Statement

Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Nome_da_planilha")

It is good to declare the used spreadsheet to prevent that when clicking another spreadsheet, the macro is activated in the wrong location.

Or if you’re in another Workbook:

Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(Filename:="C:\aminho\Para\o\Arquivo\excel.xls", ReadOnly:=True)
Set ws = wb.Worksheets("Nome_da_planilha")

Code

Option Explicit
Sub Botão_ReplicadorColuna()

    Dim i As Long, j As Long, UltimaLinha As Long, UltimaColuna As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Nome_da_planilha")

    UltimaLinha = 1048576
    UltimaColuna = 30

    Application.ScreenUpdating = False
    With ws
        For i = 1 To UltimaLinha
            For j = UltimaColuna To 4 Step -1
                If .Cells(i, j).Value <> "" Then
                    .Cells(i + 1, 2).EntireRow.Insert
                    .Cells(i + 1, 1).Value = .Cells(i, 1).Value
                    .Cells(i + 1, 2).Value = .Cells(i, 2).Value
                    .Cells(i + 1, 3).Value = .Cells(i, j).Value
                    .Cells(i, j).ClearContents
                End If
            Next j
        Next i
    End With
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub