Ali
Ali

Reputation: 7

VBA looping extremely slow

This is a data source.

enter image description here

What I am trying to do is to:

  1. Add 9000 in each empty cell in column D
  2. Concatenate column D and E in column B e.g C2&"-"&D2
  3. Add column E and F in column G

For this, I wrote code which first checks cell D2, if it is empty then add 9000. Then it concatenates D2 and E2 (C2&"-"&D2) in B2. Then adds values of E2 and F2 in G2. Then it goes to next row and select D3 and check if it is empty. Code lopes over 6000 rows. Here is the code:

Range("D2").Select
For Count = 1 To (CellsCount - 1)
    If IsEmpty(ActiveCell) Then ActiveCell.Value = 9000
    ActiveCell.Offset(0, -2).Select
    ActiveCell = Cells(1 + Count, 3) & "-" & Cells(1 + Count, 4)
    ActiveCell.Offset(0, 5).Select
    ActiveCell = Cells(1 + Count, 5) + Cells(1 + Count, 6)
    ActiveCell.Offset(1, -3).Select
Next Count

It takes approximately 10 minutes for code to run. Would appreciate if you can suggest me a faster way to run the code.

Thanks

Upvotes: 0

Views: 1299

Answers (2)

user4039065
user4039065

Reputation:

Do everything to all rows at once negating the need for loops.

with activesheet
    with .range(.cells(2, "D"), .cells(CellsCount , "D"))
        .specialcells(xlcelltypeblanks) = 9000
        .offset(0, -2).formula = "=c2&""-""&d2"
        .offset(0, -2) = .offset(0, -2).value2    'optional
        .offset(0, 3).formula = "=sum(e2, f2)"
        .offset(0, 3) = .offset(0, 3).value2      'optional
    end with
end with

Upvotes: 3

AmBo
AmBo

Reputation: 121

Don't use select / offset. Prefer using cells(row,column).

For Count = 1 To (CellsCount - 1)
    If IsEmpty(cells(count,4)) Then cells(count,4)= 9000
    cells(count,2)= Cells(1 + Count, 3) & "-" & Cells(1 + Count, 4)
    cells(count,7)= Cells(1 + Count, 5) + Cells(1 + Count, 6)
Next Count

Upvotes: 1

Related Questions