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.  

Thanks in advance,

Kind regards,
Paul
0
Reply Utf 1/19/2010 11:38:01 AM

    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 
news:795695D5-B844-44E6-B562-AD4E3E8B450B@microsoft.com...
> 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.
>
> Thanks in advance,
>
> Kind regards,
> Paul 


0
Reply Bob 1/19/2010 11:52:16 AM


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
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=171296

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

0
Reply joel 1/19/2010 12:11:42 PM

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.  
> 
> Thanks in advance,
> 
> Kind regards,
> Paul
0
Reply Utf 1/19/2010 12:23:01 PM

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.  
> > 
> > Thanks in advance,
> > 
> > Kind regards,
> > Paul
0
Reply Utf 1/19/2010 1:57:01 PM

4 Replies
439 Views

(page loaded in 0.096 seconds)

Similiar Articles:
















7/17/2012 4:42:46 AM


Reply: