Summing the numbers, resulting at least 10?

[slowokan]

Hi there.

I have one problem about summing the numbers in 9 cells in a row and doing this for the following rows as well.

The thing I need is like this;

2 3 6 5 2 7 2 4 9

First, change the number to 1, if a cell is 6 and the sum of the cells before that cells is greater than 4. In this case, we have 6 in the 3rd cell and also the sum of the cells before 3rd cell is greater (3+2=5) than 4, so 6 will be replaced by 1 and the new row is gonna look like this;

2 3 1 5 2 7 2 4 9 (The row doesn't need to be copied into another row. I wrote this just to give an idea).

Secondly, sum the numbers and if it results > 10, then stop summing and write the result next to the last cell. For this example, we get at least 10, at 4th cell, which results 2 + 3 + 1 + 5 = 11. And write the result next to the last cell(Number 9 here). And also, delete the unused cells after.

And the new row becomes;

2 3 1 5 ____________ 11 (This is the result)

And repeat this for many rows until the Activecell sees empty cell.

I wrote a function, it doesn't give an error but I don't get the exact thing I want. Thanks in advance...

Sub ToplamDeneme()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
'<o></o>
' ToplamDeneme Macro<o></o>
'<o></o>
<o></o>
'<o></o>
Do<o></o>
<o></o>
Dim Cell As Range<o></o>
Set Cell = ActiveCell.Offset(, 1)<o></o>
Do While Not IsEmpty(Cell)<o></o>
If Application.Sum(Range(Cells(ActiveCell.Row, 1), Cell)) >= 10 Then<o></o>
If Cell.Value = 6 Then<o></o>
If Application.Sum(Range(Cells(ActiveCell.Row, 1), Cell.Offset(, -1))) > 4 Then<o></o>
Cell.Value = 1<o></o>
Cells(ActiveCell.Row, 10).Value = Application.Sum(Range(Cells(ActiveCell.Row, 1), Cell))<o></o>
Range(Cell.Offset(, 1), Cells(ActiveCell.Row, 9)).Select<o></o>
Selection.ClearContents<o></o>
End If<o></o>
End If<o></o>
End If<o></o>
Set Cell = Cell.Offset(, 1)<o></o>
<o></o>
Loop<o></o>
<o></o>
ActiveCell.Offset(1, 0).Select<o></o>
<o></o>
Loop Until IsEmpty(ActiveCell)<o></o>
<o></o>
End Sub

 

[circledchicken]

Ah good point!

Try:

Sub example()

Dim lrw As Long
Dim cl As Range
Dim lsum As Double

For lrw = 1 To Range("A1").End(xlDown).Row 'loop through rows
    lsum = 0
    For Each cl In Cells(lrw, 1).Resize(1, 9)
        If cl = 6 Then
            If cl.Column <> 1 Then
                If Application.Sum(cl.Offset(0, 1 - cl.Column).Resize(1, cl.Column - 1)) > 4 Then
                    cl = 1
                End If
            End If
        End If
        lsum = lsum + cl
        If lsum >= 10 Then
            Cells(lrw, 1).Offset(0, 9) = lsum
            If cl.Column <> 9 Then
                cl.Offset(0, 1).Resize(1, 9 - cl.Column).ClearContents
            End If
            Exit For
        End If
    Next cl
Next lrw

End Sub

Note I assume you want a Total shown when >=10 not only >10.

 

[slowokan]

Now it is working great. Thanks, circledchicken...

 

[circledchicken]

Cool - your welcome.