Macro Crashing because of number of rows - Help

[Papa_Don]

Group,

I've written a couple of macros. The first one finds the last row on the spreadsheet. In my current sheet, there are approximately 55,000 rows. It works fine with no problems.

The second macro finds the blank cell (there are lots of them) and fills it in with copied data from the row above. This macro stops (or appears to stop) after 700+ iterations. Here's the short code:

Sub MergeColumnA()


For iRow = 5 To endRow
aRowVal = Cells(iRow, 1).Value
If aRowVal = "" Then
Cells((iRow - 1), 1).Select
Selection.Copy
Cells(iRow, 1).Select
ActiveSheet.Paste
End If
Next


End Sub

Is there a way to fix this so that it will run smoothly and without the spreadsheet "Not responding"?

Thanks for your help.

Don

 

[ranman256]

you could be running out of memory, OR
you need to define iROW...

Sub MergeColumnA()
dim iRow as long

 

[njimack]

You don't need to select cells to work with them but even so, looping through 55,000 rows of data will take a while. The below (untested code) is more efficient than your code, but depending on the layout of your data, you may be able to use SpecialCells(xlCellTypeBlank) to avoid looping.

Sub MergeColumnA()
Dim irow, endrow As Long
endrow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For irow = 5 To endrow
    If Cells(irow, 1) = "" Then Cells(irow, 1) = Cells(irow - 1, 1)
Next
Application.ScreenUpdating = True
End Sub

 

[Joe4]

I can only assume that you have defined and calculated "endRow" elsewhere in your code.
However, there are a few things you can do to speed up the code:
- get rid of the Select statements (not necessary)
- get rid of the Copy/Paste

I think this will be more efficient:

    Dim iRow As Long
    For iRow = 5 To endRow
        aRowVal = Cells(iRow, 1).Value
        If aRowVal = "" Then
            Cells(iRow, 1) = Cells((iRow - 1), 1)
        End If
    Next i

 

[Joe4]

njimack,
One note about your code, specifically this line:

Dim irow, endrow as Long

As it is written, irow will be declared to be Variant, not Long. Each variable must be explicitly declared, like this:

Dim irow as Long, endrow as Long

or

Dim irow as Long
Dim endrow as Long

Excel VBA is very picky like that!

 

[Takae]

Try it. Hope this helps.

Sub MergeColumnA()

    For iRow = 5 To endRow
        aRowVal = Cells(iRow, 1).Value
        If aRowVal = "" Then
            Cells((iRow - 1), 1).Copy Cells(iRow, 1)
        End If
    Next
End Sub

 

[njimack]

njimack,
One note about your code, specifically this line:

Dim irow, endrow as Long

As it is written, irow will be declared to be Variant, not Long. Each variable must be explicitly declared, like this:

Dim irow as Long, endrow as Long

or

Dim irow as Long
Dim endrow as Long

Excel VBA is very picky like that!

Good spot!

 

[Papa_Don]

I had already declared the variables as "Long".

I did discover that, after the spreadsheet said it was "Not Responding", I simply waited and the routine would finish. I'm not sure why it does that. But as long as it works, I'm fine with it.

 

[Jerry Sullivan]

Don, It sounds like you are satisfied with waiting for the code you have in your OP to finish, but if you haven't already tried the code examples Neil (Njimack) and Joe suggested, I'd encourage you to give those a try.

In my testing of 55,000 values in Column A with 10% blanks, your code went into the "Not Responding" mode and finished in about 3 minutes 30 seconds.

The code example suggested by Takae took about 3 minutes to complete.

The code examples suggested by Njmack and Joe took about 1.2 seconds to complete.
The efficiency in these examples over Takae's and your OP code comes from setting the Value property instead of using Copy-Paste.

If you have no formulas in your data in Column A, you can improve even further upon that speed through the use of an Array...

Sub FillBlanksUsingArray()
 Dim lNdx As Long, lLastRow As Long
 Dim vValues As Variant
 
 '--read values into array
 With ActiveSheet
   lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   vValues = .Range("A4:A" & lLastRow).Value
 End With
 
 '--fill blanks with previous element
 For lNdx = 2 To UBound(vValues)
   If Len(vValues(lNdx, 1)) = 0 Then
      vValues(lNdx, 1) = vValues(lNdx - 1, 1)
   End If
 Next lNdx

 '--write values back to range
 ActiveSheet.Range("A4:A" & lLastRow).Value = vValues
 
End Sub

That code takes about 0.25 seconds to complete.