Worksheet_Calculate Endless Loop

[texasalynn]

I have this code which seems to be in an endless loop? Why?

Private Sub Worksheet_Calculate()
    Const maxRow As Long = 1000
    Dim myCell As Range
    
    On Error Resume Next
        Set myCell = Range("mySecretNamedRange")
    On Error GoTo 0
    
    If Not myCell Is Nothing Then
        Select Case myCell.Row
            Case Is < maxRow
                 MsgBox "Row(s) were deleted"
                 Exit Sub
            Case Is = maxRow
                Rem no rows inserted or deleted
            Case Is > maxRow
                NRow = ActiveCell.Row
                Range(Cells(NRow - 1, "I"), Cells(NRow - 1, "GF")).Copy Destination:= _
                    Range(Cells(NRow, "I"), Cells(NRow, "GF"))
                Exit Sub
        End Select
    End If
    Rows(maxRow).Name = "mySecretNamedRange"
    ThisWorkbook.Names("mySecretNamedRange").Visible = False
    
End Sub

 

[shg]

Writing the copied cells retriggers calculation. Why are you using ActiveCell? More generally, what are you trying to do?

 

[texasalynn]

I have a sheet that I need whenever a row is inserted the formulas in columns I to GF need to be copied into the newly inserted row.

 

[shg]

Here's a way to do it without disabling events (which might be a better alternative):

Private Sub Worksheet_Calculate()
    Const maxRow    As Long = 1000
    Dim iRow        As Long

    On Error Resume Next
    iRow = Range("mySecretNamedRange").Row
    On Error GoTo 0

    Rows(maxRow).Name = "mySecretNamedRange"
    ThisWorkbook.Names("mySecretNamedRange").Visible = False

    Select Case iRow
        Case 0
            ' range doesn't (didn') exist
        Case Is < maxRow
            MsgBox "Row(s) were deleted"
        Case Is > maxRow
            ' row(s) were inserted
            With ActiveCell.EntireRow.Range("I1:GF1").Offset(-1)
                .Copy .Offset(1).Resize(iRow - maxRow)
            End With
    End Select
End Sub

 

[Rick Rothstein]

Here's a way to do it without disabling events (which might be a better alternative):

Private Sub Worksheet_Calculate()
    Const maxRow    As Long = 1000
    Dim iRow        As Long

    On Error Resume Next
    iRow = Range("mySecretNamedRange").Row
    On Error GoTo 0

    Rows(maxRow).Name = "mySecretNamedRange"
    ThisWorkbook.Names("mySecretNamedRange").Visible = False

    Select Case iRow
        Case 0
            ' range doesn't (didn') exist
        Case Is < maxRow
            MsgBox "Row(s) were deleted"
        Case Is > maxRow
            ' row(s) were inserted
            With ActiveCell.EntireRow.Range("I1:GF1").Offset(-1)
                .Copy .Offset(1).Resize(iRow - maxRow)
            End With
    End Select
End Sub

Did that work for you? I ask because I set up a very simple worksheet and inserting rows did not trigger a Calculate event (where as deleting rows did). I used this very simple formula in Columns I:GF to test with (all other cells have constant text values in them, some cells in Column H are blank)...

=IF(H1="","","X")

Anyway, I came up with this alternative code that seems to work fine (at least it does for me in XL2003) which uses the Change event instead...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim X As Long, LastRow As Long, Blanks As Range, Cell As Range
  LastRow = Columns("I").Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  On Error Resume Next
  Set Blanks = Range("I1:I" & LastRow).SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0
  If Not Blanks Is Nothing Then
    For Each Cell In Blanks
      If Blanks(1).Row = 1 Then
        Blanks.Offset(Blanks.Count).Resize(, 180).Copy Blanks(1)
      Else
        Blanks.Offset(-1).Resize(, 180).Copy Blanks(1)
      End If
    Next
  End If
End Sub

I did not disable events, but I'm not 100% sure if, on a more complex sheet, they need to be disabled or not.

 

[texasalynn]

Rick,

so is this copying the range I needed? I to GF with the offset 180? It also appears to be doing some other things I hadn't intended with looking at blanks? My brain is so overloaded I can't seem to focus.

 

[shg]

Works fine for me in Excel 2003 and 2007.

It might be better to limit the name to worksheet scope.

Private Sub Worksheet_Calculate()
    Const sRng      As String = "mySecretNamedRange"
    Const iRowMax   As Long = 1000
    Dim iRow        As Long

    On Error Resume Next
    iRow = Range(sRng).Row
    On Error GoTo 0

    If iRow <> iRowMax Then
        Me.Names.Add Name:=sRng, RefersTo:=Me.Rows(iRowMax)
        Me.Names(sRng).Visible = False
    End If

    Select Case iRow
        Case 0
            ' range doesn't (didn't) exist
        Case Is < iRowMax
            MsgBox "Row(s) were deleted"
        Case Is > iRowMax
            ' row(s) were inserted
            With ActiveCell.EntireRow.Range("I1:GF1")
                .Offset(-1).Copy .Resize(iRow - iRowMax)
            End With
    End Select
End Sub

 

[Rick Rothstein]

It also appears to be doing some other things I hadn't intended

What "other things" is it doing that you do not want it to do?

 

[texasalynn]

Shg,

I'm not understanding this line
With ActiveCell.EntireRow.Range("I1:GF1")
.Offset(-1).Copy .Resize(iRow - iRowMax)

why I1:GF1?
I only want to copy the formulas from the row above into the newly insert row.

 

[texasalynn]

What "other things" is it doing that you do not want it to do?

you code is breaking
Blanks.Offset(Blanks.Count).Resize(, 180).Copy Blanks(1)