Do ... Loop Problems

[joeyjj]

Hello All,

I would like to make a program that would do the following:

Search for the word Hz in a cell (the cell will typically have the formatting as follows 63 Hz 125 Hz 250 Hz) And set the cell right below that as the upper sum limit. Then take the row just above the activecell row and make that the lower sum limit so that it would look like this sum(UpperSumLimit:LowerSumLimit). This is my coding so far:

Sub Delete_Section_click()

Dim ws As Worksheet
Set ws = Worksheets("Input_Data")

iRow = ActiveCell.Row
Rows(iRow).Insert Shift:=xlShiftDown

i = 1

Do While ActiveCell.Value <> "Hz"

ws.Cells(iRow, 2).Value = "Sound Pressure Level"
ws.Cells(iRow, 3).NumberFormat = 0
ws.Cells(iRow, 3).Formula = "=SUM(C" & iRow - i & ":C" & iRow - 1 & ")"
ws.Cells(iRow, 4).NumberFormat = 0
ws.Cells(iRow, 4).Formula = "=SUM(D" & iRow - i & ":D" & iRow - 1 & ")"
ws.Cells(iRow, 5).NumberFormat = 0
ws.Cells(iRow, 5).Formula = "=SUM(E" & iRow - i & ":E" & iRow - 1 & ")"
ws.Cells(iRow, 6).NumberFormat = 0
ws.Cells(iRow, 6).Formula = "=SUM(F" & iRow - i & ":F" & iRow - 1 & ")"
ws.Cells(iRow, 7).NumberFormat = 0
ws.Cells(iRow, 7).Formula = "=SUM(G" & iRow - i & ":G" & iRow - 1 & ")"
ws.Cells(iRow, 8).NumberFormat = 0
ws.Cells(iRow, 8).Formula = "=SUM(H" & iRow - i & ":H" & iRow - 1 & ")"
ws.Cells(iRow, 9).NumberFormat = 0
ws.Cells(iRow, 9).Formula = "=SUM(I" & iRow - i & ":I" & iRow - 1 & ")"
ws.Cells(iRow, 10).NumberFormat = 0
ws.Cells(iRow, 10).Formula = "=SUM(J" & iRow - i & ":J" & iRow - 1 & ")"

i = i + 1

Loop

End Sub

Any Advise or help is really appreciated. Thanks!

 

[Weaver]

Have you got some sample data? I know there's a much easier way to insert your formulas (clue: read up on R1C1 notation), but I want to make sure the rest of it's okay. BTW, what's not working with your current code?

Another clue, don't set the formatting one cell at a time

<code style="white-space: nowrap;"><code>

ws.Cells(iRow, 3).resize(,8).NumberFormat = 0

</code></code>
Should replace all the individal references. It's also possible to paste a formula to multiple cells in one go, provided you can create the right commonality (where R1C1 comes in)

 

[joeyjj]

Some sample Data would be as follows:


Element 63 125 250 500 1000 2000 4000 8000

1 Example 100 100 100 100 100 100 100 100
2 Duct -5 -5 -11 -33 -62 -52 -40 -33
3 Elbow 0 -1 -6 -11 -10 -10 -10 -10
4 Branch Division -7 -7 -7 -7 -7 -7 -7 -7


Basically I would like to have this code be placed anywhere in between lines 1 2 3 4 and sum all the numbers above it UNTIL it hits the numbers 63 125 250 which are headings for the data.

 

[Weaver]

So what you're after is to select any cell within the data, then have a sum row inserted at this point? I'm assuming the headers are consistent, and the first one is always 'element'.?

 

[Weaver]

Try this:

Sub insertSumRow()
    Dim headerRow, sumRow, frstCol, lastCol
    Set el = Cells.Find("element")
    headerRow = el.Row
    firstcol = el.Column
    lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column
    sumRow = ActiveCell.Row
    Rows(sumRow).Insert
    Cells(sumRow, firstcol) = "Sound Pressure Level"
    With Range(Cells(sumRow, firstcol + 1), Cells(sumRow, lastCol))
        .NumberFormat = "0"
        .FormulaR1C1 = "=sum(r[-1]c:r" & headerRow + 1 & "c)"
    End With
End Sub

 

[joeyjj]

Thank you very much for your help! This worked Great. I need to do some customizing to allow for multiples of this line without having it sum each other (something like an if statement). I also need to rework it so that it looks for the word Elements starting from the active cell up and not from the top down. If you have any additional suggestions i really appreciate them. This code did work great THANKS!

 

[joeyjj]

I got the search order correct by adding :

Sub insertSumRow()
    Dim headerRow, sumRow, frstCol, lastCol
    Set el = Cells.Find("element", After:=ActiveCell, SearchDirection:=xlPrevious)
    headerRow = el.Row
    firstcol = el.Column
    lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column
    sumRow = ActiveCell.Row
    Rows(sumRow).Insert
    Cells(sumRow, firstcol) = "Sound Pressure Level"
    With Range(Cells(sumRow, firstcol + 1), Cells(sumRow, lastCol))
        .NumberFormat = "0"
        .FormulaR1C1 = "=sum(r[-1]c:r" & headerRow + 1 & "c)"
    End With
End Sub

However I am still stuck on having it not sum if it sees the word "sound pressure level" for example.

 

[joeyjj]

Re: Do ... Loop Problems [Solved]

Thank you very much for your inspiration it led me to solve my problem:

Sub insertSumRow()
    Dim headerRow, sumRow, frstCol, lastCol
    Set el = Cells.Find("element", After:=ActiveCell, SearchDirection:=xlPrevious)
    headerRow = el.Row
    firstcol = el.Column + 1
    lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column
    sumRow = ActiveCell.Row
    Rows(sumRow).Insert
    Cells(sumRow, firstcol) = "Sound Pressure Level"
    With Range(Cells(sumRow, firstcol + 1), Cells(sumRow, lastCol))
        .NumberFormat = "0"
        .FormulaR1C1 = "=sumifs(r[-1]c:r" & headerRow + 1 & "c, r" & sumRow - 1 & "c" & lastCol - 8 & ":r" & headerRow + 1 & "c" & lastCol - 8 & ", ""<>Sound Pressure Level"")"
    End With
End Sub

 

[Weaver]

Glad to see you got there by yourself - I've been offline for a few days, so hadn't seen your further posts.