Macro Help

[cmschmitz24]

I'm trying to insert a blank row (with some formatting) after each new item in column B.
In the new row I want to have it highlighted in a grey color in cells A-J, "Total" in column I, and sum all of column J for all items in column B in column J.


I'm working with this code:

    my_ranger = Range("A1").CurrentRegion.Address
    row_counter = Range(my_ranger).Rows.Count
    
    'ADD MORE ROWS IF NEEDED BELOW
        number_of_rows_to_insert = 4
        
    final_row_count = row_counter + 1
   
    x = 4
    initial_to_check = Range("E3").Value
    
    Do While x < final_row_count
    this_rows_value = Range("E" & x).Value
    
    If this_rows_value = initial_to_check Then
        x = x + 1
    Else
        For y = 1 To number_of_rows_to_insert
            Rows(x & ":" & x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(x & ":" & x).Clear
                        
        Next y
        
        x = x + 1 + number_of_rows_to_insert
        final_row_count = final_row_count + number_of_rows_to_insert
    End If
    
    initial_to_check = this_rows_value
        
    Loop

It would look something like this:

Thank you
Christina

 

[Fluff]

How about

Sub AddTotalsRow()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("B" & Rows.Count).End(xlUp).Row + 1 To 3 Step -1
      If Range("B" & i).Value <> Range("B" & i - 1).Value Then
            Range("B" & i).EntireRow.Insert
            Range("B" & i).Offset(0, -1).Resize(, 10).Interior.Color = 14277081
            Range("B" & i).Offset(, 7).Value = "Total"
      End If
   Next i
   For Each Rng In Range("J:J").SpecialCells(xlConstants).Areas
      Rng.Offset(Rng.Count).Resize(1).Formula = "=sum(" & Rng.Address & ")"
   Next Rng
End Sub

 

[cmschmitz24]

That's a great start!
However, I'd like to tweak a few things.

Can you pull down the cell text from above in column B and bold it? Like in my picture example (the "total" will be in column I)

Then I have a Grand Total line which sums all of column J. Now that there are multiple total rows, the Grand Total sum is incorrect.
Can you help me fix the Grand Total sum to include only the total amounts which are in the grey row?

This is my code for the Grand Total which is after the new total rows code you gave me.

LR = Range("J" & Rows.Count).End(xlUp).Row
    Range("J" & LR + 2).Formula = "=SUM(J2:J" & LR & ")"
       
    Columns("J").EntireColumn.AutoFit
       
    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    Cells(lastrow, 1).Offset(3, 8).Select
    With Selection
        .Value = "Grand Total"
        .Font.Bold = True
    End With
    
    Cells(lastrow, 1).Offset(3, 9).Select
    With Selection
        .Font.Bold = True
    End With
    
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

 

[Fluff]

How about

Sub AddTotalsRow()
   Dim i As Long
   Dim Rng As Range
   Dim TotRw As Long
   
   For i = Range("B" & Rows.Count).End(xlUp).Row + 1 To 3 Step -1
      If Range("B" & i).Value <> Range("B" & i - 1).Value Then
            Range("B" & i).EntireRow.Insert
            Range("B" & i).Offset(0, -1).Resize(, 10).Interior.Color = 14277081
            Range("B" & i).Offset(, 7).Value = "Total"
      End If
   Next i
   TotRw = Range("J" & Rows.Count).End(xlUp).Offset(3).Row
   For Each Rng In Range("J2:J" & TotRw - 1).SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count, -8).Resize(1)
         .Value = Rng.Offset(, -8).Value
         .Font.bold = True
      End With
      Rng.Offset(Rng.Count).Resize(1).Formula = "=sum(" & Rng.Address & ")"
   Next Rng
   With Range("J" & TotRw)
      .Formula = "=sum(" & Range("K2:K" & TotRw - 2).SpecialCells(xlBlanks).Offset(, -1).Address & ")"
      .Offset(, -1).Value = "Grand Total"
      .Offset(, -1).Resize(, 2).Font.bold = True
      .Borders(xlEdgeTop).LineStyle = xlContinuous
      .Borders(xlEdgeBottom).LineStyle = xlDouble
   End With
End Sub

 

[cmschmitz24]

It's giving me an error here:
.Formula = "=sum(" & Range("K2:K" & TotRw - 2).SpecialCells(xlBlanks).Offset(, -1).Address & ")"

 

[Fluff]

Try this instead

      .Formula = "=sum(" & Range("H2:H" & TotRw - 2).SpecialCells(xlBlanks).Offset(, 2).Address & ")"

 

[cmschmitz24]

Thanks, this seems to be working great so far!


I did have another question/needed help on 1 more thing -

Can you help me with this code and how to skip the first sheet?

For Each sh In ActiveWorkbook.Sheets
sh.Activate

Next sh

 

[Fluff]

If you know the name of the sheet something like

For Each sh In ActiveWorkbook.Sheets
   If sh.Name <> "Sheet1" Then
      'your code here
   End If
Next sh