Insert 2 Rows, and some formulas

[mhenk]

Hey All -

I have a large list of data that I am trying to make more concise with a macro. Basically, right now, I have it so that it goes through the data, and where the value in a certain column changes, the Macro inserts 2 new rows, and adds some labels to them. I need to add some SUMIF formulas (preferably formulas, but summing in the macro is an acceptable second method).

Here's my code, before I get too far:

Sub splitupcat_buyup()
'This macro inserts a row at each change in county, in order to easily SUM the
'non-CAT data entries in order to create concise exhibits
'Application.ScreenUpdating = False

Dim Current As String
Dim Previous As String
Dim countrec As Integer

countrec = 0
For my_rows = 3 To Range("A65536").End(xlUp).Row
countrec = countrec + 1
On Error GoTo Callout
Previous = Cells(my_rows - 1, 4).Value
Current = Cells(my_rows, 4).Value

If Previous <> Current Then
Rows(my_rows).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
For A = 1 To 4
Cells(my_rows, A).Value = Cells(my_rows - 1, A).Value
Cells(my_rows + 1, A).Value = Cells(my_rows - 1, A).Value
Next A
Cells(my_rows, 5).Value = "CAT"
Cells(my_rows + 1, 5).Value = "BUYUP"

For b = 6 To 11

'Need SUMIFS here!


Next b
my_rows = my_rows + 2
countrec = 0
End If

Next my_rows
'Application.ScreenUpdating = True
Exit Sub
Callout:
h = MsgBox("FAILED")
'Application.ScreenUpdating = True


End Sub

Now, between the "For b" and the "Next b," I want to add some SUMIF's, but the range length changes constantly, in that it is the number of records since the last change. I think that's what my CountRec variable is counting, but I'm not 100% sure it's working properly.

What I Ultimately Need:

1) Go through the data set
2) When the Value in Column D changes, insert 2 rows.
3) Copy down the labels for these two rows from the previous row
4) Add the labels in Column 5 (CAT, BUY-UP)
5) Add a SUMIF Calculation in the FIRST inserted row, 6th - 11th column
....a) This should SUM all the records since the last change in column D, (countrec entries, I think), IF the value in column 5 is equal to C

I have items 1-4 working, but the varying sumif is driving me nuts.

Any help would be appreciated. Thanks Much.

Let me know if I can clear anything up.

 

[mhenk]

Okay, I've confirmed that my CountRec variable is doing what I want, so what I really need is to be able to incorporate a formula like this:

Sum the last CountRec rows IF the Value in column 5 = C. This should be really easy!!!

 

[Norie]

Could you post some sample data?

 

[mhenk]

ALMONDS	1996	CA	Butte	C	6343.82
ALMONDS	1996	CA	Butte	L	23.92
ALMONDS	1996	CA	Butte	L	89.2
ALMONDS	1996	CA	Butte	L	281.5
ALMONDS	1996	CA	Butte	A	7909.62
ALMONDS	1996	CA	Butte	A	292.98
ALMONDS	1996	CA	Butte	A	5369.7
ALMONDS	1996	CA	Butte	L	1478.37
ALMONDS	1996	CA	Colusa	L	256.35
ALMONDS	1996	CA	Colusa	C	7773.77
ALMONDS	1996	CA	Colusa	L	271.2
ALMONDS	1996	CA	Colusa	A	1768.18
ALMONDS	1996	CA	Colusa	A	77
ALMONDS	1996	CA	Colusa	A	1000.54

Unfortunately, i can't download the nifty plugin, but above are my first 2 'records'. There are more columns of numbers after the one provided, but I figured I should be able to extend any solution to those.

I would like a Macro that changes the above to this:

ALMONDS	1996	CA	Butte	C	6343.82
ALMONDS	1996	CA	Butte	L	23.92
ALMONDS	1996	CA	Butte	L	89.2
ALMONDS	1996	CA	Butte	L	281.5
ALMONDS	1996	CA	Butte	A	7909.62
ALMONDS	1996	CA	Butte	A	292.98
ALMONDS	1996	CA	Butte	A	5369.7
ALMONDS	1996	CA	Butte	L	1478.37
ALMONDS	1996	CA	Butte	CAT	6343.82
ALMONDS	1996	CA	Butte	BUY-UP	15445.29
ALMONDS	1996	CA	Colusa	L	256.35
ALMONDS	1996	CA	Colusa	C	7773.77
ALMONDS	1996	CA	Colusa	L	271.2
ALMONDS	1996	CA	Colusa	A	1768.18
ALMONDS	1996	CA	Colusa	A	77
ALMONDS	1996	CA	Colusa	A	1000.54
ALMONDS	1996	CA	Colusa	CAT 	7773.77
ALMONDS	1996	CA	Colusa	BUY-UP	3373.27

The value in the CAT Rows is the sum of the previous rows where the 5th column is equal to C, and the value in the BUY-UP rows is the sum of the previous rows where the 5th column is anything BUT C.

I can get everything to appear correctly except for these final two sums. I can easily get the labels to appear, but the SUM part is driving me nuts.[/code]

 

[Norie]

Try this.

Sub InsertRows()
Dim rng As Range
Dim s As Long

    Set rng = Range("D3")
    s = 3
    
    While rng.Value <> ""
        If rng.Value <> rng.Offset(1).Value Then
        
            rng.Offset(1).Resize(2).EntireRow.Insert
            rng.Offset(, -3).Resize(, 4).Copy rng.Offset(1, -3).Resize(2)
            rng.Offset(1, 1) = "CAT"
            rng.Offset(2, 1) = "BUY-UP"
            rng.Offset(1, 2).Formula = "=SUMIF(E" & s & ":E" & rng.Row & "," & Chr(34) & "C" & Chr(34) & ",F" & s & ":F" & rng.Row & ")"
            rng.Offset(2, 2).Formula = "=SUMIF(E" & s & ":E" & rng.Row & "," & Chr(34) & "<>C" & Chr(34) & ",F" & s & ":F" & rng.Row & ")"

            Set rng = rng.Offset(2)
            s = rng.Row + 1
        End If
        Set rng = rng.Offset(1)
        
    Wend
    
End Sub

 

[mhenk]

Works beautifully! Thanks a ton.