Hello,

There are only a few tiny modifications required to be in line with your new worksheet structure ...

Hope this will helpCode:Sub NewSumPrevious6() ' Sum Previous 6 Values On Error Resume Next Dim Rng As Range, Dn As Range, n As Long, K As Variant, R As Range, c As Long, Tot As Long Dim temp As Long, V As Range, fD As Boolean Set Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).Resize(, 2) With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare For Each Dn In Rng If Not .Exists(Dn.Value) Then .Add Dn.Value, Dn Else Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn) End If Next Dn For Each K In .keys For Each V In .Item(K) c = 0: Tot = 0: temp = 0 For Each R In .Item(K) If R.Address = V.Address Then fD = True If fD Then If c = 0 And temp <> 0 Then R.Offset(, 61).Value = temp: temp = 0 fD = False: Exit For End If c = c + 1 Tot = Tot + R.Offset(, 16).Value If c = 6 Then temp = Tot c = 0: Tot = 0 End If End If Next R Next V Next K End With End Sub

## Like this thread? Share it with others