subroutine to calculate the sum of numbers in a row

[mbababrik]

ok im new to this wesite and a new user of VBA
I have a column of numbers, that I don’t know the length in advance, but is located in column A. I want to write a subroutine that calculates the sum of the following
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Sum=1<SUP>st</SUP> number* last number+ 2<SUP>nd</SUP> number*next to last number + 3<SUP>rd</SUP> number* 3<SUP>rd</SUP> to last number etc. If the total number of numbers is odd, the middle number will have nothing to pair it with. In this case, square the middle number and add it to the sum. Note that the column contains only numbers and blank lines, and blank lines are found only after the column has ended.
i got the part on how to determine if the number is odd or even
Sub checkifevenorodd()
Dim userentry As Long
userentry = WorksheetFunction.CountA(Columns(1))
userentrydiv2 = CInt(userentry / 2)
userentrydiv2times2 = userentrydiv2 * 2
If userentrydiv2times2 = userentry Then
MsgBox ("even")
Else
MsgBox ("odd")
End If
End Sub
i appreciate any help
thank you

 

[HalfAce]

i got the part on how to determine if the number is odd or even

Starting with this... all the code below:

Sub checkifevenorodd()
Dim userentry As Long
userentry = WorksheetFunction.CountA(Columns(1))
userentrydiv2 = CInt(userentry / 2)
userentrydiv2times2 = userentrydiv2 * 2
If userentrydiv2times2 = userentry Then
MsgBox ("even")
Else
MsgBox ("odd")
End If
End Sub

can be replaced with this one liner...

If Right(WorksheetFunction.CountA(Columns(1)) / 2, 2) = ".5" Then MsgBox "odd" Else MsgBox "even"

Now you need, what... to add the first & last values, add the 2nd & 2nd to last values, 3rd & 3rd to last... etc? (and then square the middle value & add to the rest if applicable)?

 

[mbababrik]

thank you for the quick reply
yes i need to find the sum of the product of the 1st last 2nd first and 2nd last etc...
sum=(1st value*last value)+(2nd first*2ndlast)...
if even than just give the sum but if odd the value left in the middle ( the one that cant pair w anything) square it and add it to the whole sum

 

[HalfAce]

Ohhh, you want the first # times the last # added to the 2nd # times the 2nd to last #, etc. (yes?)

If that's the case, does this return the expected result?

Sub CalcDemo()

Dim LstRo As Long, Ro As Long, _
    MidVal As Long, MidValRo As Long, _
    TotalCount As Long
    
LstRo = Cells(Rows.Count, "A").End(xlUp).Row
MidVal = 0
TotalCount = 0
If Right(WorksheetFunction.CountA(Range("A1:A" & LstRo)) / 2, 2) = ".5" Then
  MidValRo = Cells((LstRo / 2) + 0.5, "A").Row
  MidVal = Cells(MidValRo, "A").Value * Cells(MidValRo, "A").Value
End If
For Ro = 1 To LstRo
  If Ro >= MidValRo Then Exit For
  TotalCount = TotalCount + Cells(Ro, "A") * Cells(LstRo, "A")
  LstRo = LstRo - 1
Next Ro
TotalCount = TotalCount + MidVal
MsgBox "The calculated sum equates to " & TotalCount

End Sub

Note: It assumes your data is all in column A starting in row 1 and that you will run this code with that being the active sheet.

Let us know what changes to make from here...

 

[mikerickson]

Dim lastRow as Long, i As Long
Dim Total as Double

lastRow = Cells(Rows.Count, 1).End(xlup).Row

For i = 1 to lastRow
    Total = Total + Cells(i,1)* Cells(LastRow - i + 1, 1)
Next i

If (LastRow/2) <> Int(LastRow/2) Then
    Total = Total + Cells(Int(lastRow/2), 1) * Cells(Int(lastRow/2) + 1, 1)
End If

Total = Total / 2

 

[HalfAce]

Hi Mike,
Much cleaner. I like it.
But... when I ran that on my sample data I got different results from the (long) code I posted.
When I amend this line from:
Total = Total + Cells(Int(lastRow / 2), 1) * Cells(Int(lastRow / 2) + 1, 1)
to:
Total = Total + Cells(Int(lastRow / 2 + 1), 1) * Cells(Int(lastRow / 2) + 1, 1)
then I get the same result.

 

[mbababrik]

thank you mike
ok so when i used MIKES code with the changes that halface suggested it works perfectly
code:
Sub calcdemo()
Dim lastRow As Long, i As Long
Dim Total As Double
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
Total = Total + Cells(i, 1) * Cells(lastRow - i + 1, 1)
Next i
If (lastRow / 2) <> Int(lastRow / 2) Then
Total = Total + Cells(Int(lastRow / 2 + 1), 1) * Cells(Int(lastRow / 2) + 1, 1)
End If
Total = Total / 2
MsgBox "The Sum equals" & Total
End Sub


thank you halface
to test it i just entered 1 on like the first 4 cells and then to the first 5 cells. whn its 5 it gives the right answer but with for values it gives zero.
so i tried more number and each time the number of populatd cells on column A is even it gives back a zero but when it i odd it gives back the right answer.

 

[mikerickson]

I was about to correct that. Thanks for catching it.

Also, since I don't trust users, I'd use Val(CStr(Cells(i,j))) throughout to protect against a string or error value being in one of the cells.
Another approach would handle a mix of numbers and text, ignoring text (and errors) rather than treating them as 0.

Sub test()
    Dim highRow As Long, lowRow As Long
    Dim Total As Double
    
    lowRow = 1
    highRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Do
        Do Until IsNumeric(Cells(lowRow, 1))
            lowRow = lowRow + 1
        Loop

        Do Until IsNumeric(Cells(highRow, 1))
            highRow = highRow - 1
        Loop
        
        If highRow < lowRow Then Exit Do
        
        Total = Total + Cells(lowRow, 1) * Cells(highRow, 1)
        
        lowRow = lowRow + 1
        highRow = highRow - 1
    Loop Until highRow <= lowRow

    MsgBox Total
End Sub

 

[mbababrik]

thank you very much.
one last thing since im new and i know its a gd thing to do
how do I mark this thread as solved
thank you guys i wasnt expecting an answer this fast
love this site.

 

[mikerickson]

Darn it, I blew it again. The end of the outer loop should be

Loop Until highRow < lowRow