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!!


[TABLE="width: 500"]
<tbody>[TR]
[TD]Ref[/TD]
[TD]Cost[/TD]
[TD]Size[/TD]
[TD]Info[/TD]
[TD]Date[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]9[/TD]
[TD]17.8[/TD]
[TD]Product 1[/TD]
[TD]14/02/18[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]101[/TD]
[TD]39.5[/TD]
[TD]Product 2[/TD]
[TD]14/02/18[/TD]
[/TR]
[TR]
[TD]1235[/TD]
[TD]33[/TD]
[TD]6.6[/TD]
[TD]Product 97[/TD]
[TD]19/04/18[/TD]
[/TR]
</tbody>[/TABLE]

Will need to turn into (Just image but with 400 Orders and 10,000 rows):
[TABLE="width: 500"]
<tbody>[TR]
[TD]Ref[/TD]
[TD]Cost[/TD]
[TD]Size[/TD]
[TD]Info[/TD]
[TD]Date[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]9[/TD]
[TD]17.8[/TD]
[TD]Product 1[/TD]
[TD]14/02/18[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]101[/TD]
[TD]39.5[/TD]
[TD]Product 2[/TD]
[TD]14/02/18[/TD]
[/TR]
[TR]
[TD]TOTAL[/TD]
[TD]110[/TD]
[TD]57.3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1235[/TD]
[TD]33[/TD]
[TD]6.6[/TD]
[TD]Product 97[/TD]
[TD]19/04/18[/TD]
[/TR]
</tbody>[/TABLE]


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