Search code examples
excelinsertspreadsheetsubtotalvba

If ID's match insert new row and total values in other columns

I have a spreadsheet that has about 19 columns and the amount of rows are always changing. Column A contains "Item IDs", column N contains "# of Items Sold", and column O contains "# of Items". I am trying to create a macro that inserts a row every time the "Item ID" in column A changes, and totals up the "# of Items Sold" as well as the "# of Items". I would also like to copy the "Item ID" into this new row if possible. If anybody could help me with this I would be VERY appreciative.

UPDATE: See below for screenshots of the spreadsheet example (I tried to post images but since I'm new I guess I don't have this level of access yet).

How the spreadsheet looks now:

example1

How I would like the spreadsheet to look after running the macro:

example2

Solution

  • ZygD, I appreciate your help. I really was looking for a macro as this is just one of probably 7 or so macro's that are going to be tied into a one button solution for somebody else who doesn't have the time/knowledge to subtotal these rows.

    I came up with a macro that copied the spreadsheet to a temp sheet. In that temp sheet it adds a gray row every time the ID changes, and subtotals the 2 aforementioned columns... while copying all the other info down. However, this caused Excel to freeze up for a while... so instead I had it delete all columns except the ones I needed, subtotal, & delete all rows except the one's that are gray (subtotaled). Here's the macro I came up with (in case anybody else is looking for something similar):

    Sub SubTotal()

Dim i As Long
Dim numberOfRows As Long
Dim j

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Copies SellerTotals to SellerTotals(Temp)
Sheets("SellerTotals").Select
Sheets("SellerTotals").Copy Before:=Sheets("Pacing")
Sheets("SellerTotals (2)").Select
Sheets("SellerTotals (2)").Name = "SellerTotals(Temp)"
Worksheets("SellerTotals(Temp)").Activate

Range("B:M,P:T").Select
Selection.Delete Shift:=xlToLeft

' number of IDs
numberOfRows = Cells(Rows.Count, "A").End(xlUp).Row

' do bottom row first
Cells(numberOfRows + 1, 1).Value = Cells(numberOfRows, 1).Value
Cells(numberOfRows + 1, 2).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-1]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-1],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
Cells(numberOfRows + 1, 3).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-2]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-2],""" & Cells(numberOfRows, 1).Value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"

' convert to value
Cells(numberOfRows + 1, 2).Value = Cells(numberOfRows + 1, 2).Value
Cells(numberOfRows + 1, 3).Value = Cells(numberOfRows + 1, 3).Value

Range(Cells(numberOfRows + 1, 1), Cells(numberOfRows + 1, 3)).Interior.Color = RGB(192, 192, 192)

' insert blank row in between each group of IDs
' loop backwards because we are inserting rows
For i = numberOfRows To 3 Step -1
If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
  Cells(i, 1).EntireRow.Insert xlShiftDown

  ' copy ID name down
  Cells(i, 1).Value = Cells(i - 1, 1).Value

  ' put formula into Total & Total Cap field
  Cells(i, 2).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-1]:R[-" & i - (i - 1) & "]C[-1],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
  Cells(i, 3).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-2]:R[-" & i - (i - 1) & "]C[-2],""" & Cells(i, 1).Value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"

  ' convert to value
  Cells(i, 2).Value = Cells(i, 2).Value
  Cells(i, 3).Value = Cells(i, 3).Value

  Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(192, 192, 192)

End If
Next i

  ' Delete Blank Rows

    For j = Range("A1").End(xlDown).Row To 2 Step -1
    If Cells(j, 1).Interior.Color <> RGB(192, 192, 192) Then Cells(j, 1).EntireRow.Delete

Next j

End Sub