PDA

View Full Version : [SOLVED] Avoid Loop to Find (and replace) empty cells



Felix Atagong
09-16-2004, 06:27 AM
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.

mvidas
09-16-2004, 06:52 AM
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


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

brettdj
09-16-2004, 06:23 PM
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

=IF(A5=A4,B4+C5,C5)
and this into E5
"XX"

Cheers

Dave


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

Felix Atagong
09-17-2004, 02:45 AM
Many thanks. I have now 3 solutions to choose from (also one of AskMrExcel). I will time them all and let you know!

Zack Barresse
09-17-2004, 07:00 AM
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! :)

brettdj
09-18-2004, 04:24 AM
If you wanted the values only and not the IF formulas then


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

roos01
09-18-2004, 10:00 AM
if you want to use the specialcells options it could be something like:



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


Jeroen

Felix Atagong
09-24-2004, 05:03 AM
FireFytr,
It was here:
( http://www.mrexcel.com/board2/viewtopic.php?t=106067&highlight= )
but have no fear,
I use the solution that was given...
here!