Domanda

For some reason when i use the insert line code, it keeps on inserting a new row forever! I wrote the code that at the beginning there is a do while loop that goes through all the cells in column C, when it hits a cell in column C that is empty then an variable keeps the cell number.

and then i wrote another subroutine (which gets called when something changes on the spreadsheet) that if something is written in that empty cell in column C, then insert new row. but it just keeps on going forever!

The following code is under a module

Dim a, count As Integer
Sub check()
a = 0
count = 3

Do While a = 0
    count = count + 1

    If Range("C" & count).Value = "" Then
        a = 1
    End If
Loop
End Sub


Sub addrow()

    If Range("C" & count).Value <> "" Then

        Range("C" & count).Offset(1).EntireRow.Insert
        count = count + 1

         With Range("B" & count, "AL" & count)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
        End With

    End If

End Sub

And this code is under the worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
    addrow
End Sub

and subroutine "CHECK" is being called when the workbook is opened.

I have no idea why there is an infinite loop! please help.

Thank you

È stato utile?

Soluzione

Just sandwich your Worksheet_Change event with Application.EnableEvents=False/True:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    addrow
    Application.EnableEvents = True
End Sub

The reason is simple - when Worksheet_Change event inserts new row, it changes the content of the sheet, triggering Worksheet_Change event again. Worksheet_Change event insert new row again, and so on. Infinity loop:)

Btw, the best practice is to use error handling (it sets back Application.EnableEvents = True even if error occurs in addrow subroutine):

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler

    Application.EnableEvents = False
    addrow

ExitHere:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Resume ExitHere
End Sub
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top