Option Explicit
Const ZZ As String = "ZZ>" 'used in all subs, ZZ used to help with sorting later
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Selection.CountLarge > 1 Then Exit Sub
Dim DIDs As Range: Set DIDs = Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(-1)).Offset(1)
If Not Intersect(Target, DIDs) Is Nothing Then
Cancel = True
Target.Value = ZZ & Target.Value
Target.Value = Replace(Target.Value, ZZ & ZZ, "")
Cells(1, 1).Activate
With DIDs.Resize(, DIDs.CurrentRegion.Columns.Count)
.Sort Key1:=Cells(2, 2), Order1:=xlAscending
.Sort Key1:=Cells(2, 1), Order1:=xlAscending
End With
End If
End Sub
Private Sub CommandButton1_Click()
Dim Func As WorksheetFunction: Set Func = WorksheetFunction
Dim c As Long, r As Long, x As Long, lastC As Long, rng As Range, cel As Range
Application.ScreenUpdating = False
Set rng = Sheets("Summary").Range("A1").CurrentRegion
r = rng.Rows.Count + 1
lastC = rng.Columns.Count
'copy values to new sheet
With Sheets.Add(before:=Sheets(1))
rng.Parent.Cells.Copy
.Activate
.Cells.PasteSpecial (xlPasteAll)
.Cells.PasteSpecial (xlPasteColumnWidths)
.Cells(1, 1).Select
'add totals
With .Cells(r, 1).Resize(5)
.Value = Func.Transpose(Array(" Included:", "", " Excluded:", "", " Total DIDs:"))
.Font.Bold = True
End With
For c = 2 To lastC
.Cells(r + 4, c) = Func.Sum(rng.Columns(c))
.Cells(r + 2, c) = Func.SumIf(rng.Resize(, 1), ZZ & "*", rng.Columns(c))
.Cells(r, c) = .Cells(r + 4, c) - .Cells(r + 2, c)
Next c
'move total to correct line
On Error Resume Next: x = .Range("A:A").Find(ZZ & "*").Row: On Error GoTo 0
If x > 0 Then .Rows(r).Resize(2).Cut: .Cells(x, 1).Insert Shift:=xlDown
'remove ZZ
For Each cel In .Range(rng.Address).Resize(rng.Rows.Count + 2, 1)
cel.Value = Replace(cel.Value, ZZ, "")
Next cel
End With
End Sub