CODEWITHSUNDEEP
vbaexcel
Ivan Yim
Ivan Yim

Reputation: 21

Infinite loop in set range

I'm not sure why this keeps looping infinitely. Although I set my range, my code does not exit the loop after all the rows in my range (rng) have been examined. 

Option Explicit

Sub prnt()
    Dim i As Long
    Dim rng As Range
    Dim cell As Range
    Dim row As Range

    Set rng = ActiveSheet.Range("B8:F57")

    For Each row In rng.Rows
        For Each cell In rng.Rows.Cells
            If cell <> "" Then
                cell.Copy
                Range("i8").Offset(i, 0).PasteSpecial
                i = i + 1
            Else
            End If

        Next cell

    Next row


End Sub

Upvotes: 1

Views: 1160

Answers (1)

Andy Wynn
Andy Wynn

Reputation: 1273

OK, I had to properly format your code to look at this problem, and here it is, properly indented without the whitespace and with the cell variable swapped for cel, and the row variable swapped for rngRow:

Sub prnt()
   Dim i As Long
   Dim rng As Range
   Dim cel As Range
   Dim rngRow As Range

   Set rng = ActiveSheet.Range("B8:F57")

   For Each rngRow In rng.Rows
       For Each cel In rng.Rows.Cells
            If cel <> "" Then
                cel.Copy
                Range("i8").Offset(i, 0).PasteSpecial
                i = i + 1
            Else

            End If
        Next cell
    Next row
End Sub

Immediately I notice that your first loop does literally nothing for the code. You use rngRow (or row in your original) as the loop control variable, but never refer to it in the code itself, so already the program takes 50 times longer to process, because you are cycling through 250 cells, 50 times each for no reason at the moment.

The rngRow variable is being set to B8:F8, then B9:F9 etc, for each loop.

The cel variable is being set to B8, C8, D8 ... B9, C9 etc before rngRow gets set to B9:F9, so as I said above, you'll end up with 50 duplicate values for any cell in that range that does not evaluate to "".

This code fixes that, and it checks the text attribute of the cell, so it won't break if it comes across a cell error (#N/A etc)

Sub prnt()
    Dim i As Long
    Dim rng As Range
    Dim cel As Range
    Dim rngRow As Range

    Set rng = ActiveSheet.Range("B8:F57")

    For Each cel In rng.Rows.Cells
        If cel.Text <> "" Then
            cel.Copy
            Range("i8").Offset(i, 0).PasteSpecial
            i = i + 1
        End If
    Next cel
End Sub

Apologies if this sounded condescending, that was not my intention.

Hope this helps!

Upvotes: 2

Related Questions