Avoid Loop to Find (and replace) empty cells

I have an item list of several thousands of items, with in column:
A - item number
B - stock balance
C - new entry
D - date
E - warehouse position

A macro adds new items to those already in stock. To make a new Balance, I do a loop through column E. If that cell is Empty (E5 for instance) I see if the item (cell A) already exists and if it does like in Cell A4, the new balance is the old balance + the new added item (B5 = C5 + B4). I then put a 'XX' in Cell E5 to make it clear that this problem has been solved. If an item is entirely new (Cell A11) then the Balance is equal to the value of cell C (B11 = C11).

Beginning of the year all goes well, but now in September the macro is slow because of the loop that looks in a few thousand of rows. I know there is a SpecialCells method but haven't managed to implement that, would that be faster and can someone show me how it should work.

Hi Felix,

Rather than loop through all the cells in column E, you may only want to loop through the cells which are blank in column e. Here is an example, it creates a range "rg" which consists of only the blank cells in column e. You can uncomment my rg.select statement if you want to see which cells it will loop through. Might be a better loop for you, save time without going through the full cells.

Matt

Code:

---

Sub newerLoop()
 Dim rg As Range, cl As Range
 Set rg = Intersect(Columns(5), ActiveSheet.UsedRange).SpecialCells(xlCellTypeBlanks)
 'rg.Select
 For Each cl In rg.Cells
  'code to perform on the blank cells in column e
 Next cl
End Sub

---

You could take this a step further and do a one shot formula on all the cells in Column B that have a corresponding blank cell in Column E

ie this code inserts this formula into B5 if it qualifies

Code:

---

=IF(A5=A4,B4+C5,C5)

---

and this into E5
"XX"

Cheers

Dave

Code:

---

Sub NewLoop()
Dim Rg        As Range
    'there may be no blank cells
    On Error Resume Next
    'Find all cells in column B that have a corresponding blank cell in column E in the usedrange
    Set Rg = Intersect(Range("E:E"), ActiveSheet.UsedRange, Cells.SpecialCells(xlCellTypeBlanks)).Offset(0, -3)
    On Error GoTo 0
    'Add the formula to the B cells and the XX to E cells
    If Not Rg Is Nothing Then
        Rg.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],R[-1]C+RC[1],RC[1])"
        Rg.Offset(0, 3) = "XX"
    End If
End Sub

---

Many thanks. I have now 3 solutions to choose from (also one of AskMrExcel). I will time them all and let you know!

Hello Felix,

As there isn't anything wrong with cross-posting your question(s) at multiple forums, we have a lot of people from many other forums also, it would help if you also posted the links to your other posts - general consideration. Thanks! :)

If you wanted the values only and not the IF formulas then

Code:

---

Sub NewLoop()
    Dim Rg        As Range
    'there may be no blank cells
    On Error Resume Next
    'Find all cells in column B that have a corresponding blank cell in column E in the usedrange
    Set Rg = Intersect(Range("E:E"), ActiveSheet.UsedRange, Cells.SpecialCells(xlCellTypeBlanks)).Offset(0, -3)
    On Error GoTo 0
    'Add the formula to the B cells and the XX to E cells
    If Not Rg Is Nothing Then
        Rg.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],R[-1]C+RC[1],RC[1])"
        Rg.Formula = Rg.Value
        Rg.Offset(0, 3) = "XX"
    End If
End Sub

---

Cheers

Dave

if you want to use the specialcells options it could be something like:

Code:

---

Sub FindBlankCells()
On Error Resume Next
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Value = "xxx"
End Sub

---

Jeroen

FireFytr,
It was here:
( http://www.mrexcel.com/board2/viewto...6067&highlight= )
but have no fear,
I use the solution that was given...
here!