Create an unknown Sum formula! 2

[APElliott]

Hello,

In summing up if I have several ranges of cash values in column D with each range seperated by a blank row can I sum the ranges in colum C on the first row off the data.

But to explain further:

I have a worksheet with volume/page references in colmn A ie 02/06 (you might remember it).

Say the first page ref was in cell A3 and in cells D36 we had some currency values. If rows 2 and 7 are blank is there a code to sum D36 in say cell C3.

But to complicate things the range will vary ie it may be D310 that needs the formula applying to.

And to further complicate things going back to the original range of D36. If A8 was the next page ref could a sum formula be applied to a range of cells say D810 with the same principal as before.

I'm lost! Apologies if I've lost you.

Thankyou in advance

Andrew

 

[Bowers74]

Hi Andrew,

The code is a bit crude, but if I understood you correctly, this should do the trick.

Sub SumRanges()
Dim nSum As Double
Dim c As Range
Range("A3").Select
Do Until ActiveCell.Row >= 65536
    Set c = ActiveCell.Offset(0, 3)
    If c = "" Or c.Offset(1, 0) = "" Then
        nSum = WorksheetFunction.Sum(Range(c, c.End(xlDown)))
    Else
        nSum = c.Value
    End If
    ActiveCell.Offset(0, 2) = nSum
    ActiveCell.End(xlDown).Select
Loop
Range("A1").Select
End Sub

Hope this helps!

Mike

If you can't be "The Best", be the best at what you can!!!

Never say Never!!!
Nothing is impossible!!!

 

[Bowers74]

Oooops,

Sorry Andrew . . . I guess I should have paid a little bit more attention to the results of the code before I posted it. The following code DOES work though:

Sub SumRanges()
Dim SumRows As Integer
Dim c As Range
Range("A3").Select
Do Until ActiveCell.Row >= 65536
    Set c = ActiveCell.Offset(0, 3)
    If c = "" Or c.Offset(1, 0) = "" Then
        SumRows = Range(c, c.End(xlDown)).Count - 1
        ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[1]:R[" & SumRows & "]C[1])"
    Else
        ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[1]:R[3]C[1])"
    End If
    ActiveCell.End(xlDown).Select
Loop
Range("A1").Select
End Sub

Sorry about the mistake.

Peace!



If you can't be "The Best", be the best at what you can!!!

Never say Never!!!
Nothing is impossible!!!

 

[Stripester]

Friends forever.

Superb!!!!

Cheers Mike, just the trick!

Andrew

 

[APElliott]

Whoops,

Just responded from my collegues machine!

Thanks again.

Andrew

 

[APElliott]

Mike,

Just run a couple more tests, and encountered a few problems.

Where the range is only 1 row long it sums this row the blank row and 1 further row.

And for any other ranges, 2 rows or over it is creating a sum 4 rows long.

Also I've developed my worksheet a little today and instead of the ranges being in D they are in Q:Q and the formula needs to be in I:I instead of C:C.

Cheers,

Andrew

 

[Bowers74]

OK Andrew but only for another star! ;-)

Sub SumRanges()
Dim SumRows As Integer
Dim c As Range
Range("A3").Select
Do Until ActiveCell.Row >= 65536
    Set c = ActiveCell.Offset(0, 16)
    If c = "" Or c.Offset(1, 0) = "" Then
        ActiveCell.Offset(0, 8).FormulaR1C1 = "=SUM(RC[8])"
    Else
        SumRows = Range(c, c.End(xlDown)).Count - 1
        ActiveCell.Offset(0, 8).FormulaR1C1 = "=SUM(RC[8]:R[" & SumRows & "]C[8])"
    End If
    ActiveCell.End(xlDown).Select
    Set c = Nothing
Loop
Range("A1").Select
End Sub

Sorry about the mix-up with the single row sums, I got my If clause mixed up. It was kinda late.

Peace!

Mike

If you can't be "The Best", be the best at what you can!!!

Never say Never!!!
Nothing is impossible!!!

 

[APElliott]

Cheers Mike,

Yours is a lot sexier than mine below!

Thanks

Andrew

I'm Star mad now!!!


Sub SearchForNonBlankCellsAndABitMore()

For i = 2 To [a65536].End(xlUp).Row
If Not IsEmpty(Cells(i, "A&quot) Then
Cells(i, "A&quot.Select
ActiveCell.Offset(-1, 16).Select
If ActiveCell.Offset(2, 0) = ("&quot Then
ActiveCell.Value = ActiveCell.Offset(1, 0)
Else
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[" & _
ActiveCell.Offset(1, 0).Range("A1&quot.End(xlDown).Row _
- ActiveCell.Row & "]C)"
End If
ActiveCell.Offset(1, -8).Value = ActiveCell.Value
ActiveCell.Value = ""
End If
Next i
[A2].Select
End Sub

 

[mustangcoupe]

I need a code that dose something simular but sums the cells above it and one cell right....

so if cell E4 and E10 are blank I need it to sum E5:E9 and put it in F10


I tried to understand the above code but got lost....

Todd