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]

Hi,

You can try the following (assuming your range starts in A1):

Option Explicit

Sub example()

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

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

End Sub

 

[slowokan]

Thank you, circledchicken. A very clean and short solution. Appreciated.

It gives an error on the line "If Application.Sum(cl.Offset(0, 1 - cl.Column).Resize(1, cl.Column - 1)) > 4 Then"

What could be the problem?

 

[circledchicken]

Oops sorry, I think that might happen if the first column has a 6 in it as cl.Column - 1 becomes 0 and .Resize(1, 0) doesn't then make sense.

Try this instead:

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
            cl.Offset(0, 1).Resize(1, 9 - cl.Column).ClearContents
            Exit For
        End If
    Next cl
Next lrw

End Sub

Note that it will only work if your range goes from A1:I1 and below.

 

[slowokan]

Thank you very much, circledchicken. You have the talent!!!

 

[circledchicken]

Your welcome!

 

[slowokan]

circledchicken. One little problem, I have now. If a row is like this;

1 1 1 1 1 1 1 1 1

It stops going down all the rows. Because, it sums all the cells and gives the total next to last cell and can not find any cells to delete. So, I think it fails because of "ClearContents" command, because it doesn't find any cells to clear, since all the cells are used on this occasion. So, the macro stops at that row.

By the way, it doesn't give any error. Where should I modify to overcome this, circledchicken?

 

[slowokan]

By the way, it doesn't give any error.

Oh, sorry. It gives error.

 

[circledchicken]

I don't think I understand.
If you have a row with all 1 - since the Sum is 9 (not >10) it would not put the total in column 10. It should just move on to the next row and continue, leaving the row with 1's exactly as it is.

Maybe post a sample of 5 of your rows and what the error is and I can try help?

 

[slowokan]

Sorry, last cell is 2 or 3 or 4 or 5, when the total gets 10 or more at the last cell. So, there is no cell to be cleared, because all the cells are used for the sum.

The cells like these;

1 1 1 1 1 1 1 1 2
1 1 1 1 1 1 1 1 3
1 1 1 1 1 1 1 1 4
1 1 1 1 1 1 1 1 5