Multiple cell range and loop difficulty

[johnnyb5]

I've filtered and sorted a worksheet so that it has multiple areas of data, the data is always in columns "A:P". The grouping of areas will have a different number of rows but there is always two blank rows in-between the areas. Then I made the macro add the sum of each area in column "D". This part wasn't the problem.

The problem is: I wanted to sum other columns just like I did in "D". I could not successfully adjust the "Range Portion" of the macro so that it summed multiple columns as it moved down the sheet from area to area. I wanted to sum the column in "D" as shown but also the columns from "H" through "M" as well.

If someone could assist me with adjusting the range so that it would sum each of the columns it would be great, additionally, I repeat the last paragraph of the code 11 times to finish the worksheet. I'm using the "Selection.End(xlDown).Select" over and over instead of a loop. If someone could help me loop that paragraph so I didn't have to repeat it 11 times; then it would be a big bonus for me.

'SUM BETWEEN BLANK ROWS AND PLACE RESPONSE BELOW AREA
Sheets("MY FLEETS").Select
Dim Trw As Long
Dim Brw As Long
Range("D2").Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
ActiveCell.Offset(1, 0).Select
Selection.Formula = "=Sum(D" & Trw & ":D" & Brw & ")"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With

Selection.End(xlDown).Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
ActiveCell.Offset(1, 0).Select
Selection.Formula = "=Sum(D" & Trw & ":D" & Brw & ")"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With

Thanks for your time and assistance,
JB

 

[NotoriousPopol]

Hi,

I think what you want to do is a FormulaR1C1. Like

Col=4 ' For column D
Cells(2, Col).Select
...
Selection.FormulaR1C1 = " =Sum(R" & Trw & "C" & Col & ":R" & Brw & "C" & Col & ")"

where Col is your column number.

 

[Coding4Fun]

Here you go this will do what you are looking for

As the previous post mentioned you need the R1C1 formula format. I also accommodated the request to loop through the entire sheet so that you dont have to replicate this code for each range you want to sum

Sheets("MY FLEETS").SelectDim Trw As Long
Dim Brw As Long


LR = Cells(Rows.Count, "A").End(xlUp).Row


Range("D2").Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
ActiveCell.Offset(1, 0).Select


ProcessRow = Brw + 2
Do Until ProcessRow > LR + 1


For i = 4 To 13


If i = 4 Or i = 8 Or i = 9 Or i = 10 Or i = 11 Or i = 12 Or i = 13 Then
Cells(Brw + 1, i).Select
ActiveCell.FormulaR1C1 = "=Sum(R" & Trw & "C:R" & Brw & "C)"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With


End If


Next i


Cells(Brw + 1, 4).Select
Selection.End(xlDown).Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row


If ActiveCell.Row = 1048576 Then
Range("A1").Select
Exit Sub
Else
Cells(Brw + 1, 4).Select
ProcessRow = ActiveCell.Row
End If


Loop

 

[johnnyb5]

Thank You Gentlemen, I appreciate your assistance.
'Coding Fan', Your macro was exactly what I needed!!! All I had to do to put it inside my macro was to change the "Exit Sub" to "Exit Do" and if worked like a charm for the worksheets that I had. You assistance with the loop helped me to delete about 200 lines of redundant code or so.

I have spent a few hours trying to make another adjustment. When adopting your macro for a worksheet that has areas that contain single rows as well as multi-row areas, it automatically jumps down to the next area from the single row and Sums the additional areas rows. Originally I didn't have any single rows for areas. I thought I might be able to insert an "IF THEN" statement like : ""If ActiveCell.Offset(-1, 0) = "=" Then Brw = Trw And ActiveCell.Offset(-2, 0)"" as well as a few other versions. However, this did not solve the problem at all.

Would you be able to suggest an edit that would allow the "Sum" to work with single row areas as well as multi row areas?

Thanks Again,
JB

 

[Coding4Fun]

Try this, I am not sure where you made your previous adjustment regarding Exit Do but this should do the trick to account for any number of spaces between the data sections (except for 0 spaces)

Sub Test()

Sheets("MY FLEETS").Select
Dim Trw As Long
Dim Brw As Long


LR = Cells(Rows.Count, "A").End(xlUp).Row


Range("D2").Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
ActiveCell.Offset(1, 0).Select


ProcessRow = Brw + 2
Do Until ProcessRow > LR + 1


For i = 4 To 13


If i = 4 Or i = 8 Or i = 9 Or i = 10 Or i = 11 Or i = 12 Or i = 13 Then
Cells(Brw + 1, i).Select
ActiveCell.FormulaR1C1 = "=Sum(R" & Trw & "C:R" & Brw & "C)"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With


End If


Next i


Cells(Brw + 1, 4).Select


If ActiveCell.Offset(1, 0) = "" Then
Selection.End(xlDown).Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row


ElseIf ActiveCell.Offset(1, 0) <> "" Then
ActiveCell.Offset(1, 0).Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
End If


If ActiveCell.Row = 1048576 Then
Range("A1").Select
Exit Sub
Else
Cells(Brw + 1, 4).Select
ProcessRow = ActiveCell.Row
End If


Loop


End Sub

 

[Coding4Fun]

Ok my previous post is not correct I dont think, I thought you meant having only one row as a seperating space between the sections of data (You previously mentioned always having to empty rows between your data sections.

I think you actually meant that the data section itself only contains one record. Either way the following code will work. Again you will need to make whatever adjustment you refer to RE: Exit Do

Sub Test()Sheets("Sheet1").Select
'Sheets("MY FLEETS").Select
Dim Trw As Long
Dim Brw As Long


LR = Cells(Rows.Count, "A").End(xlUp).Row


Range("D2").Select
Trw = ActiveCell.Row
Selection.End(xlDown).Select
Brw = ActiveCell.Row
ActiveCell.Offset(1, 0).Select


ProcessRow = Brw + 2
Do Until ProcessRow > LR + 1


For i = 4 To 13


If i = 4 Or i = 8 Or i = 9 Or i = 10 Or i = 11 Or i = 12 Or i = 13 Then
If Brw > Trw Then
Cells(Brw + 1, i).Select
ActiveCell.FormulaR1C1 = "=Sum(R" & Trw & "C:R" & Brw & "C)"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Else
Cells(Trw + 1, i).Select
ActiveCell.FormulaR1C1 = "=Sum(R" & Trw & "C:R" & Trw & "C)"
Selection.Font.Bold = True
Selection.Interior.Color = RGB(226, 239, 238) 'green
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
End If


Next i


If Brw > Trw Then
Cells(Brw + 1, 4).Select
Else
Cells(Trw + 1, 4).Select
End If


If ActiveCell.Offset(1, 0) = "" Then
    Selection.End(xlDown).Select
    Trw = ActiveCell.Row
    
    If ActiveCell.Row = 1048576 Then
    Range("A1").Select
    Exit Sub
    End If
    
    If ActiveCell.Offset(1, 0) = "" Then
    ActiveCell.Offset(1, 0).Select
    Else
    Selection.End(xlDown).Select
    Brw = ActiveCell.Row
    End If
    
ElseIf ActiveCell.Offset(1, 0) <> "" Then
    ActiveCell.Offset(1, 0).Select
    Trw = ActiveCell.Row
    Selection.End(xlDown).Select
    Brw = ActiveCell.Row




End If


If ActiveCell.Row = 1048576 Then
Range("A1").Select
Exit Sub
Else
If Trw < Brw Then
Cells(Brw + 1, 4).Select
ProcessRow = ActiveCell.Row
Else
ProcessRow = ActiveCell.Row
End If
End If


Loop


End Sub

 

[johnnyb5]

Coding4Fun,
Wow, this piece that you wrote is spectacular!! I had hours and hours that ran into days and more days in trying to make it work. You were correct in your deduction that I meant the data are of the sheet only contained one line and that there are always two blank lines in-between the data areas. The areas with one line of data really through me when trying to identify a Top Row and a Bottom Row. I replaced my coded attempts with your new MACRO and it worked for everything PERFECTLY!!!

Much thanks again!!!
JB

 

[Coding4Fun]

Glad I could help, thank you for the positive feedback