VBA to remove duplicate cell values and format subtotals

[bntringa]

Hi all - first post here.

I have a spreadsheet with subtotals and am looking to remove duplicate values in cells as per the attached. This should run through the entire spreadsheet and remove values where the are the same in columns A:H that are highlighted in red.

Lastly, can I use VBA to bold the "Total" values in column K of each total row?

Thank you!

 

[DanteAmor]

Hello @bntringa
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

Try this:

Sub removeduplicate()
  Dim dic As Object
  Dim rng As Range, f As Range
  Dim lr As Long, i As Long, j As Long
  Dim ky As String, cell As String
  Dim a As Variant
  
  Application.ScreenUpdating = False
  
  lr = Range("A" & Rows.Count).End(3).Row
  Set rng = Range("A" & lr + 1)
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A1:H" & lr).Value
  
  For i = 1 To UBound(a, 1)
    ky = ""
    For j = 1 To 8
      ky = ky & Cells(i, j).Value & "|"
    Next
    If Not dic.exists(ky) Then
      dic(ky) = Empty
    Else
      Set rng = Union(rng, Range("A" & i))
    End If
  Next
  rng.EntireRow.Delete
  
  Set rng = Range("K" & lr + 1)
  Set f = Range("A:A").Find("Total", , xlValues, xlPart, , , False)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      Set rng = Union(rng, Range("K" & f.Row))
      Set f = Range("A:A").FindNext(f)
    Loop While f.Address <> cell
  End If
  rng.Font.Bold = True
  
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​