adding all the cells in a group of cells

[MarkS]

Hi,
I need to know the sum of a group of cells I us this piece of code to do
this job

dTotal = 0
iRowCounter1 = 2
iColumnCounter1 = 5
Do Until Sheets("Futures").Cells(iRowCounter1, iColumnCounter1).Value = ""
Do Until Sheets("Futures").Cells(iRowCounter1, iColumnCounter1).Value = ""
dTotal = dTotal + Sheets("Futures").Cells(iRowCounter1,
iColumnCounter1).Value
iRowCounter1 = iRowCounter1 + 1
Loop
iRowCounter1 = 2
iColumnCounter1 = iColumnCounter1 + 1
Loop

Does any one know how to do this, without looping through all the cells, as
it is always the same size

Thanks MarkS

 

[OssieMac]

Hi Mark,

Three options. first two basically the same but the first one finds the last
cell of the range first before assigning the entire range to a variable.

The second option does the above in one line of code.

Third option is just simple code if you actually know the range.

The space and underscore at the end of lines are line breaks in otherwise
single lines of code. (Just in case you are not aware of this)

Sub Sum_a_Range_Option1()

Dim dTotal As Long
Dim iRowCounter1 As Long
Dim iColumnCounter1 As Long
Dim rngToSum As Range
Dim rngLastCell As Range

dTotal = 0
iRowCounter1 = 2
iColumnCounter1 = 5

With Sheets("Futures")

'Assign last cell to a range variable
Set rngLastCell = .Cells(iRowCounter1, _
iColumnCounter1).End(xlDown).End(xlToRight)

'Assign the entire range to a range variable
Set rngToSum = Range(.Cells(iRowCounter1, _
iColumnCounter1), rngLastCell)

End With

dTotal = WorksheetFunction.Sum(rngToSum)

End Sub

Sub Sum_a_Range_Option2()

Dim dTotal As Long
Dim iRowCounter1 As Long
Dim iColumnCounter1 As Long
Dim rngToSum As Range

dTotal = 0
iRowCounter1 = 2
iColumnCounter1 = 5

With Sheets("Futures")

'Assign the entire range to a range variable
'using only one line of code
Set rngToSum = Range(.Cells(iRowCounter1, _
iColumnCounter1), .Cells(iRowCounter1, _
iColumnCounter1).End(xlDown).End(xlToRight))

End With

dTotal = WorksheetFunction.Sum(rngToSum)

End Sub

Sub Sum_a_Range_Option3()

Dim dTotal As Long

dTotal = WorksheetFunction.Sum(Sheets("Futures") _
.Range("E2:I15"))


End Sub

 

[Nayab]

Hi,
I need to know the sum of a group of cells I us this piece of code to do
this job

dTotal = 0
iRowCounter1 = 2
iColumnCounter1 = 5
Do Until Sheets("Futures").Cells(iRowCounter1, iColumnCounter1).Value =""
  Do Until Sheets("Futures").Cells(iRowCounter1, iColumnCounter1).Value= ""
   dTotal = dTotal + Sheets("Futures").Cells(iRowCounter1,
iColumnCounter1).Value
   iRowCounter1 = iRowCounter1 + 1
  Loop
iRowCounter1 = 2
iColumnCounter1 = iColumnCounter1 + 1
Loop

Does any one know how to do this, without looping through all the cells, as
it is always the same size

Thanks MarkS

why not use the the sum method of excel:

u can calculate the sum in some remote cell may be
Range("IV65536").value and then make dTotal equal to this value and
then clear contents from IV65536.

 

[kounoike]

Hi
If your data start at Cells(2,5) and consecutive(no empty cells between
data) in both column's and row's direction , Macro as below would work.

Sub sumtest0()
Dim rng As Range

On Error Resume Next
Set rng = Range(Cells(2, 5), Cells(Cells.Rows.Count, _
Cells.Columns.Count)).SpecialCells(xlCellTypeConstants, 1)
rng.Select '<--- just for checking the range of sum
If Not rng Is Nothing Then
MsgBox Application.Sum(rng)
Else
MsgBox "Nothing to sum"
End If
End Sub

If your data has empty cells between data, the Macro above would not work,
instead, try this one.
But i don't know this one is as efficient as your code.
Be sure that Sheets("Futures") is selected before running both macros

Sub sumtest1()
Dim clast As Range, rlast As Range, clrng As Range
Dim cell As Range, sumrng As Range

If Cells(2, 5) = "" Then
MsgBox "Nothing to sum"
Exit Sub
Else
If Cells(2, 5).Offset(0, 1) = "" Then
Set clast = Cells(2, 5)
Set clrng = clast
Else
Set clast = Cells(2, 5).End(xlToRight)
Set clrng = Range(Cells(2, 5), clast)
End If
End If

Set sumrng = Nothing

For Each cell In clrng
If cell.Offset(1, 0) = "" Then
If sumrng Is Nothing Then
Set sumrng = cell
Else
Set sumrng = Union(sumrng, cell)
End If
Else
Set rlast = cell.End(xlDown)
If sumrng Is Nothing Then
Set sumrng = Range(cell, rlast)
Else
Set sumrng = Union(sumrng, Range(cell, rlast))
End If
End If
Next
sumrng.Select '<--- just for checking the range of sum
MsgBox Application.Sum(sumrng)
End Sub

keiji