How to optimize VBA code with loop

[dmadhup]

Hi,

My below code is working fine but I want to optimize it using a loop. Can I re-write below code using any loop in VBA?

        Set rng2 = ws.Range("O14:O500")
        Set rng3 = ws.Range("P14:P500")
        Set rng4 = ws.Range("Q14:Q500")
        Set rng5 = ws.Range("R14:R500")
        Set rng6 = ws.Range("S14:S500")

        Range("O14").Value = Application.WorksheetFunction.Sum(rng2.SpecialCells(xlCellTypeVisible))
        Range("P14").Value = Application.WorksheetFunction.Sum(rng3.SpecialCells(xlCellTypeVisible))
        Range("Q14").Value = Application.WorksheetFunction.Sum(rng4.SpecialCells(xlCellTypeVisible))
        Range("R14").Value = Application.WorksheetFunction.Sum(rng5.SpecialCells(xlCellTypeVisible))
        Range("S14").Value = Application.WorksheetFunction.Sum(rng6.SpecialCells(xlCellTypeVisible))

Your help is appreciated. Thank you

 

[JoeMo]

Not sure what "working fine" means as your sum range seems to include the cell you place the sum into. Assuming you want the sum one cell above the top of the sum range, maybe this shorter version:

Sub test0()
Dim R As Range
Set R = ws.Range("O14:S500")
For i = 0 To 4
    Range("O13").Offset(0, i).Value = _
        Application.WorksheetFunction.Sum(R.Columns(i + _
        1).SpecialCells(xlCellTypeVisible))
Next i
End Sub

 

[dmadhup]

Thanks for the response. Not getting expected result. I think we can't write this like:
Set R = ws.Range("O14:S500")

 

[offthelip]

If you are really trying to optimize your code you can speed it up by using variant arrays. One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action. So the way I approach the problem , i would load the entire range from O14 to S500 into a single variant array, i would define an output aray from O14 to S14 and then do a loop from 14 to 500 to do the 5 sums. What this doesn't take into account is what filters you have got to hide some of the rows, so that would need to be put in the loop as well. Since you haven't given any details I can't make suggstions.

Sub summ()
Dim inarr() As variant
Dim outarr() As Variant


inarr = Range("O15:S500")
outarr = Range("O14:S14")
 For i = 1 To 485
   For k = 1 To 5
    outarr(1, k) = outarr(1, k) + inarr(i, k)
   Next k
 Next i
  Range("O14:S14") = outarr
  End Sub

 

[Norie]

Perhaps.

Dim I As Long

    Set rng = ws.Range("O14:O500")

    For I = 0 To 4
       rng.Offset(I).Cells(1,1).Value = Application.Sum(rng.Offset(I).SpecialCells(xlCellTypeVisible)) 
    Next I

 

[dmadhup]

Thanks all for the response.
In JoeMo Solution, I just changed this line: Range("O14").Offset(0, i).Value. It works.

 

[dmadhup]

Hi Offthelip

Thanks for your idea about using the variant. I am using the following filter to select only particular data:

Dim rng As Range
Set rng = ws.Range("A14:A500")
rng.AutoFilter field:=1, Criteria1:=1

 

[offthelip]

here you are with the test for 1 in column in the vba, this means that there is no need to apply the filter, this will speed you code up even more:

Sub summ()
Dim inarr() As Variant
Dim outarr() As Variant
Dim cola() As Variant


'pick up columnA
cola = Range("A14:A500")
inarr = Range("O14:S500")
' initialise sums to zero
outarr = Range("O14:S14")
For k = 1 To 5
 outarr(1, k) = 0
Next k
 For i = 1 To 485
'test if column = 1
If cola(i, 1) = 1 Then
   For k = 1 To 5
    outarr(1, k) = outarr(1, k) + inarr(i, k)
   Next k
   End If
 Next i
  Range("O14:S14") = outarr
  End Sub

 

[dmadhup]

Thank you offthelip for great approach solving the problem.
I appreciate your help.