Macro Needed To Insert Rows, Sum Data

Microsoft Excel 2003 (full product)
August 19, 2010 at 09:03:02
Specs: Windows XP
I need a macro to do a few things for me

Date Invoice Class Amount
7-7-7 123 Green 2.56
7-7-7 123 Green 4.19
7-21-8 124 Blue 10.00
7-21-8 124 Blue 5.00
7-21-10 610 Red 11.11

Based on column B(invoice) i need to
1. Insert row above column which begins with different invoice.
2.column A(date) and column C(class) into row above
3. sum the total for the same Invoice number in column d in the newly inserted row aove but have it be negative

I have varying amounts of rows and entries. PLEASE HELP

See More: Macro Needed To Insert Rows, Sum Data

August 20, 2010 at 06:34:37

This macro inserts rows above a change in invoice, copying the data from columns A and C in the row below and inserting the negative of the sums of the invoices in the rows below.

Your example data becomes this:

	A	B	C	D
1	Date	Invoice	Class	Amount
2	7-7-7		Green	-6.75
3	7-7-7	123	Green	2.56
4	7-7-7	123	Green	4.19
5	7-21-8		Blue	-15
6	7-21-8	124	Blue	10
7	7-21-8	124	Blue	5
8	7-21-10		Red	-11.11
9	7-21-10	610	Red	11.11

I suggest that you run this macro from a button on your worksheet.

On the worksheet create a command button from the Control Toolbox toolbar.
(If this isn't visible, right click on an existing toolbar and check the Control Toolbox).
Select the button Icon and draw a button
Right-click the button and select Command Button - Edit and change the name to 'Summarize' or something else suitable.
Right-click the button again and select View Code
In the code window that opens enter this:

Option Explicit

Private Sub CommandButton1_Click()
Dim rngStart As Range
Dim rngEnd As Range
Dim strInvoice As String
Dim dblLastChange As Double
Dim n As Double

With ActiveSheet
    'set start row
    Set rngStart = .Range("A1")
    'find end of data in column A
    Set rngEnd = .Range("A" & CStr(Application.Rows.Count)) _
    'set invoice string to last row value (in col. B /offset =1)
    strInvoice = rngEnd.Offset(0, 1).Text
    'set last change row to last row
    dblLastChange = rngEnd.Row
    'loop through the data starting at last row
    For n = rngEnd.Row To rngStart.Row Step -1
        'test if it has changed
        If .Range("B" & CStr(n)).Text <> strInvoice Then
            'its changed
            'save new invoice text
            strInvoice = .Range("B" & CStr(n)).Text
            'insert row below
            .Rows(CStr(n + 1)).Insert
            'copy columns A and C from row below
            'note that new row is now row n+1
            .Range("A" & CStr(n + 2)).Copy _
                    Destination:=.Range("A" & CStr(n + 1))
            .Range("C" & CStr(n + 2)).Copy _
                    Destination:=.Range("C" & CStr(n + 1))
            'add all values in column D from row n+1
            'to last change row
            .Range("D" & CStr(n + 1)).Value = _
                -Application.WorksheetFunction _
                .Sum(.Range("D" & CStr(n + 2) & _
                ":D" & CStr(dblLastChange + 1)))
            'save new last change row
            dblLastChange = n
        End If
    Next n
End With
End Sub

Note that Private Sub CommandButton1_Click() and End sub will already be present, so don't duplicate them. Option Explicit goes before Private Sub CommandButton1_Click().
Some lines of code have been split onto two lines for ease of viewing, using the line continuation character "_". This should work 'as is' just copy and paste, or you could remove the "_" and bring the code back to one line.

Click File - Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.
Exit design mode (first icon on the Controls Toolbox toolbar).

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on very limited sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

Click the 'Summarize' button to run the macro


Report •

August 31, 2010 at 07:10:03
Thank you , my friend!!!!!! You made life a whole lot easier.

Report •

August 31, 2010 at 08:00:59
Thank You!!!!!!!!!!!!!! That was awesome!

Report •

Related Solutions

August 31, 2010 at 16:08:34

Glad to have been able to help.

and thanks for the Thanks.



Report •

Ask Question