Macro to automatically sort a table

[Jburgy]

Hello!

I'm stuck trying to gaps into a table, I hope this makes sense

It starts off like this with around 10,000 rows and some redundant columns to delete but I need to (currently) go through and manually add a break in the table to add the order total and total size

I'm wondering if I can create a macro to do this quicker and where is the best place to start with figuring out how to do it. I tried recording a macro but it only did the task on one line before crashing. Any advice is greatly appreciated!!

Ref	Cost	Size	Info	Date
1234	9	17.8	Product 1	14/02/18
1234	101	39.5	Product 2	14/02/18
1235	33	6.6	Product 97	19/04/18

<tbody>
</tbody>

Will need to turn into (Just image but with 400 Orders and 10,000 rows):

Ref	Cost	Size	Info	Date
1234	9	17.8	Product 1	14/02/18
1234	101	39.5	Product 2	14/02/18
TOTAL	110	57.3
1235	33	6.6	Product 97	19/04/18

<tbody>
</tbody>

Is it possible to create a break every time the order reference changes and add in the total cells like above?

 

[Fluff]

How about

Sub addTotals()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Range("A" & i).Value <> Range("A" & i - 1).Value Then Rows(i).Insert
   Next i
   For Each Rng In Range("A:A").SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1, 3)
         .Formula = Array("Totals", "=sum(" & Rng.Offset(, 1).Address & ")", "=sum(" & Rng.Offset(, 2).Address & ")")
         .Font.Bold = True
      End With
   Next Rng
End Sub

 

[Jburgy]

How about

Sub addTotals()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Range("A" & i).Value <> Range("A" & i - 1).Value Then Rows(i).Insert
   Next i
   For Each Rng In Range("A:A").SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1, 3)
         .Formula = Array("Totals", "=sum(" & Rng.Offset(, 1).Address & ")", "=sum(" & Rng.Offset(, 2).Address & ")")
         .Font.Bold = True
      End With
   Next Rng
End Sub

This is great thank you so much!

If I add more columns to total up say in column I, how would I then also total those with the formula above? I can't quite figure it out

 

[Fluff]

If you wanted to sum columns 2:4 add to the code like

Sub addTotals()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Range("A" & i).Value <> Range("A" & i - 1).Value Then Rows(i).Insert
   Next i
   For Each Rng In Range("A:A").SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1, [COLOR=#ff0000]4[/COLOR])
         .Formula = Array("Totals", "=sum(" & Rng.Offset(, 1).Address & ")", "=sum(" & Rng.Offset(, 2).Address & ")", [COLOR=#ff0000]"=sum(" & Rng.Offset(, 3).Address & ")"[/COLOR])
         .Font.Bold = True
      End With
   Next Rng
End Sub

 

[Jburgy]

Fantastic thank you, I did figure it out eventually but didn't know how to edit post to say so! (Didn't know if double post was allowed or no)

 

[Fluff]

Glad it's sorted & thanks for the feedback.

Posting more than once is fine, as long as you are not simply repeating yourself.

 

[Jburgy]

Glad it's sorted & thanks for the feedback.

Posting more than once is fine, as long as you are not simply repeating yourself.

Thanks for letting me know!

If i want to also highlight the newly created row in grey for example, how would I do that?

 

[Fluff]

Like

Sub addTotals()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Range("A" & i).Value <> Range("A" & i - 1).Value Then Rows(i).Insert
   Next i
   For Each Rng In Range("A:A").SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1, 4)
        [COLOR=#0000ff] .Interior.Color = 14277081[/COLOR]
         .Formula = Array("Totals", "=sum(" & Rng.Offset(, 1).Address & ")", "=sum(" & Rng.Offset(, 2).Address & ")", "=sum(" & Rng.Offset(, 3).Address & ")")
         .Font.Bold = True
      End With
   Next Rng
End Sub

 

[Jburgy]

Like

Sub addTotals()
   Dim i As Long
   Dim Rng As Range
   
   For i = Range("[B]D[/B]" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Range("[B]D[/B]" & i).Value <> Range("[B]D[/B]" & i - 1).Value Then Rows(i).Insert
   Next i
   For Each Rng In Range("[B]D:D[/B]").SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1, 4)
        [COLOR=#0000ff] .Interior.Color = 14277081[/COLOR]
         .Formula = Array("Totals", "=sum(" & Rng.Offset(, 1).Address & ")", "=sum(" & Rng.Offset(, 2).Address & ")", "=sum(" & Rng.Offset(, 3).Address & ")")
         .Font.Bold = True
      End With
   Next Rng
End Sub

Thank you so much again!!

 

[Fluff]

You're welcome