Below is code that nilem supplied a week ago and I have added a couple of lines to delete some conditional formatting and it works as needed, but not I'm stumped with needing to copy/paste some formatting. The code that I have tried is red below.
Will someone help me with this? This is the last piece of the puzzle for what I've been working on.
Sub SumCells()
ActiveSheet.Outline.ShowLevels RowLevels:=2
Dim r As Range, i As Long, adr As String
For Each r In Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2).Areas
i = r.Row + r.Count
Cells(i, 6).Formula = "=SUM(" & r.Offset(, 4).Address(0, 0) & ")"
Cells(i, 9).Formula = "=SUM(" & r.Offset(, 7).Address(0, 0) & ")"
Cells(i, 11).FormatConditions.Delete
Cells(i, 12).FormatConditions.Delete
Cells(i + 1, 11).Resize(, 2).Clear
adr = adr & "," & Cells(i, 6).Address(0, 0)
Next r
With Cells(i + 2, 6)
.Formula = "=SUM(" & Mid(adr, 2) & ")"
.Copy .Offset(, 3)
''''''''''''''''''''''''''''''''' .Copy .Offset(2, 0).PasteSpecial Paste:=xlPasteFormats <-- NEED TO COPY FORMATTING from 2 cells above
End With
End Sub
It took some time, but I solved this problem myself. The solution is...
Sub SumCells()
ActiveSheet.Outline.ShowLevels RowLevels:=2
Dim r As Range, i As Long, adr As String
For Each r In Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2).Areas
i = r.Row + r.Count
Cells(i, 6).Formula = "=SUM(" & r.Offset(, 4).Address(0, 0) & ")"
Cells(i, 9).Formula = "=SUM(" & r.Offset(, 7).Address(0, 0) & ")"
Cells(i, 11).FormatConditions.Delete
Cells(i, 12).FormatConditions.Delete
Cells(i + 1, 11).Resize(, 2).Clear
adr = adr & "," & Cells(i, 6).Address(0, 0)
Next r
With Cells(i + 2, 6)
.Formula = "=SUM(" & Mid(adr, 2) & ")"
.Font.Name = "Tahoma"
.Font.Size = 8
.Copy .Offset(, 3)
End With
End Sub
Usually someone answers very quickly when I post a question here, but maybe I've asked too much.
Bookmarks