MSGROUPS.NET | Search | Post Question | Groups | Stream | About | Register

### VBA Code to calculate SUM and COPY&PASTE cell value in inserted li

• Follow

```Good morning,

I hope someone can assist me with this (btw, if this is a duplicate of a
post I just made, apologies... my IE browser said that an issue had occured,
and I don't believe it did post)

I have the following code to insert a line after groups (of 2 rows usually*):
Sub test()
firstrow = 2 'set to your first data row
lastrow = 300 'set or caclulate lat data row
datecolumn = 9 'assign as necessary
checkrow = firstrow
While checkrow < lastrow
If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
Rows(checkrow + 1).EntireRow.Insert
checkrow = checkrow + 2
lastrow = lastrow + 1
Else: checkrow = checkrow + 1
End If
Wend
End Sub

However, what I need now (and can't work out at all), is for the following
to occur within that inserted blank line:
in column 6 - sum of grouped rows above
in column 8 - sum of grouped rows above
in column 9 - copy text that is in row above

Example:
1    2     3    4   5    6   7   8   9
x    x     x     x   x    1   x   2   y
x    x     x     x   x    3   x   4   y
4        6   y

Please if someone can help me add this extra requirement into my code (or
have a new module to do this) I would be so grateful.

Kind regards,
Paul
```
 0

```    firstrow = 2 'set to your first data row
datecolumn = 9 'assign as necessary
lastrow = Cells(Rows.Count, datecolumn).End(xlUp).Row 'set or caclulate
lat data row
checkrow = firstrow
startrow = firstrow
While checkrow < lastrow + 1
If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn)
Then
Rows(checkrow + 1).EntireRow.Insert
Cells(checkrow + 1, 6).FormulaR1C1 = "=SUM(R" & startrow &
"C:R[-1]C)"
Cells(checkrow + 1, 8).FormulaR1C1 = "=SUM(R" & startrow &
"C:R[-1]C)"
Cells(checkrow + 1, datecolumn).Value = Cells(checkrow,
datecolumn).Value
checkrow = checkrow + 2
startrow = checkrow
lastrow = lastrow + 1
Else
checkrow = checkrow + 1
End If
Wend

HTH

Bob

"PVANS" <PVANS@discussions.microsoft.com> wrote in message
> Good morning,
>
> I hope someone can assist me with this (btw, if this is a duplicate of a
> post I just made, apologies... my IE browser said that an issue had
> occured,
> and I don't believe it did post)
>
> I have the following code to insert a line after groups (of 2 rows
> usually*):
> Sub test()
> firstrow = 2 'set to your first data row
> lastrow = 300 'set or caclulate lat data row
> datecolumn = 9 'assign as necessary
> checkrow = firstrow
> While checkrow < lastrow
> If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
> Rows(checkrow + 1).EntireRow.Insert
> checkrow = checkrow + 2
> lastrow = lastrow + 1
> Else: checkrow = checkrow + 1
> End If
> Wend
> End Sub
>
> However, what I need now (and can't work out at all), is for the following
> to occur within that inserted blank line:
> in column 6 - sum of grouped rows above
> in column 8 - sum of grouped rows above
> in column 9 - copy text that is in row above
>
> Example:
> 1    2     3    4   5    6   7   8   9
> x    x     x     x   x    1   x   2   y
> x    x     x     x   x    3   x   4   y
>                            4        6   y
>
> Please if someone can help me add this extra requirement into my code (or
> have a new module to do this) I would be so grateful.
>
>
> Kind regards,
> Paul

```
 0

```See if this helps

Sub test()
FirstRow = 2 'set to your first data row
lastrow = 300 'set or caclulate lat data row
datecolumn = 9 'assign as necessary
checkrow = FirstRow
While checkrow < lastrow
If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
Rows(checkrow + 1).EntireRow.Insert
For col = 1 To (datecolumn - 1)
Set Sumrange = Range(Cells(FirstRow, col), Cells(checkrow, col))
MySum = WorksheetFunction.Sum(Sumrange)
If MySum <> 0 Then
Cells(checkrow + 1, col) = MySum
End If
Next col
checkrow = checkrow + 2
lastrow = lastrow + 1
Else: checkrow = checkrow + 1
End If
Wend
End Sub

--
joel
------------------------------------------------------------------------
joel's Profile: 229

[url=&quot;http://www.thecodecage.com&quot;]Microsoft Office Help[/url]

```
 0

```Modified your code to suit the requirement....

Sub test()
firstrow = 2 'set to your first data row
lastrow = 300 'set or caclulate lat data row
datecolumn = 9 'assign as necessary
checkrow = firstrow
While checkrow < lastrow
If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
Rows(checkrow + 1).EntireRow.Insert
Range("F" & checkrow + 1).Formula = _
"=SUM(F" & firstrow & ":F" & checkrow & ")"
Range("H" & checkrow + 1).Formula = _
"=SUM(H" & firstrow & ":H" & checkrow & ")"
Range("I" & checkrow + 1) = Range("I" & checkrow)
firstrow = checkrow + 2
checkrow = checkrow + 2
lastrow = lastrow + 1
Else: checkrow = checkrow + 1
End If
Wend
End Sub

--
Jacob

"PVANS" wrote:

> Good morning,
>
> I hope someone can assist me with this (btw, if this is a duplicate of a
> post I just made, apologies... my IE browser said that an issue had occured,
> and I don't believe it did post)
>
> I have the following code to insert a line after groups (of 2 rows usually*):
> Sub test()
> firstrow = 2 'set to your first data row
> lastrow = 300 'set or caclulate lat data row
> datecolumn = 9 'assign as necessary
> checkrow = firstrow
> While checkrow < lastrow
> If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
> Rows(checkrow + 1).EntireRow.Insert
> checkrow = checkrow + 2
> lastrow = lastrow + 1
> Else: checkrow = checkrow + 1
> End If
> Wend
> End Sub
>
> However, what I need now (and can't work out at all), is for the following
> to occur within that inserted blank line:
> in column 6 - sum of grouped rows above
> in column 8 - sum of grouped rows above
> in column 9 - copy text that is in row above
>
> Example:
> 1    2     3    4   5    6   7   8   9
> x    x     x     x   x    1   x   2   y
> x    x     x     x   x    3   x   4   y
>                             4        6   y
>
> Please if someone can help me add this extra requirement into my code (or
> have a new module to do this) I would be so grateful.
>
>
> Kind regards,
> Paul
```
 0

```Jacob,

thank you so much - I really appreciate it.  It works perfectly

Thanks Bob and Joel for your input as well, I appreciate the assistance

regards

"Jacob Skaria" wrote:

> Modified your code to suit the requirement....
>
> Sub test()
> firstrow = 2 'set to your first data row
> lastrow = 300 'set or caclulate lat data row
> datecolumn = 9 'assign as necessary
> checkrow = firstrow
> While checkrow < lastrow
> If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
> Rows(checkrow + 1).EntireRow.Insert
> Range("F" & checkrow + 1).Formula = _
> "=SUM(F" & firstrow & ":F" & checkrow & ")"
> Range("H" & checkrow + 1).Formula = _
> "=SUM(H" & firstrow & ":H" & checkrow & ")"
> Range("I" & checkrow + 1) = Range("I" & checkrow)
> firstrow = checkrow + 2
> checkrow = checkrow + 2
> lastrow = lastrow + 1
> Else: checkrow = checkrow + 1
> End If
> Wend
> End Sub
>
> --
> Jacob
>
>
> "PVANS" wrote:
>
> > Good morning,
> >
> > I hope someone can assist me with this (btw, if this is a duplicate of a
> > post I just made, apologies... my IE browser said that an issue had occured,
> > and I don't believe it did post)
> >
> > I have the following code to insert a line after groups (of 2 rows usually*):
> > Sub test()
> > firstrow = 2 'set to your first data row
> > lastrow = 300 'set or caclulate lat data row
> > datecolumn = 9 'assign as necessary
> > checkrow = firstrow
> > While checkrow < lastrow
> > If Cells(checkrow, datecolumn) <> Cells(checkrow + 1, datecolumn) Then
> > Rows(checkrow + 1).EntireRow.Insert
> > checkrow = checkrow + 2
> > lastrow = lastrow + 1
> > Else: checkrow = checkrow + 1
> > End If
> > Wend
> > End Sub
> >
> > However, what I need now (and can't work out at all), is for the following
> > to occur within that inserted blank line:
> > in column 6 - sum of grouped rows above
> > in column 8 - sum of grouped rows above
> > in column 9 - copy text that is in row above
> >
> > Example:
> > 1    2     3    4   5    6   7   8   9
> > x    x     x     x   x    1   x   2   y
> > x    x     x     x   x    3   x   4   y
> >                             4        6   y
> >
> > Please if someone can help me add this extra requirement into my code (or
> > have a new module to do this) I would be so grateful.
> >
> >
> > Kind regards,
> > Paul
```
 0

4 Replies
439 Views

Similiar Articles:

7/17/2012 4:42:46 AM