VBA to sum

Hi,

you must see this tread …

If I were a moderator I surely compare the IP addresses !

Yes. I want to run code in sheet 7. Given desired result also on onther sheet.

Originally Posted by Marc L

If I were a moderator I surely compare the IP addresses !

There is no such need, in the file option "about the author" is the same person ...

Originally Posted by winmaxservices

...Given desired result also on onther sheet.

For example, instead of:

    With rng.Resize(n + 1)
        Union(.Columns(1), .Columns(3)).Copy r.End(xlToRight)(, 3)
        Union(.Columns(1), .Columns(2)).Copy r.End(xlToRight)(, 2)
    End With

you can write:

    With rRng.Resize(n + 1)
        Union(.Columns(1), .Columns(2), .Columns(3)).Copy r.End(xlToRight)(, 2)
    End With

'rRng' because 'Rng' is property of 'Sort' object.

For example, instead of:

    With r.End(xlToRight)(n + 2).Resize(, 3)
        .FormulaR1C1 = "=sum(r" & r.Row + 1 & "c:r[-1]c)"
        .Font.Bold = True
    End With

you can write:

    With r.End(xlToRight)(n + 2).Offset(0, -1).Resize(, 4)
        .FormulaR1C1 = "=sum(r" & r.Row + 1 & "c:r[-1]c)"
        .Offset(0, -1).Cells(1, 1).Value = "Grand Total"
    End With

And formatting at the end of the code, e.g.:

    With r
        .End(xlToRight)(n + 2).Offset(0, -9).Resize(, 10).Font.Bold = True
        .Range("A1").CurrentRegion.EntireColumn.AutoFit
    End With

, etc.

But you can try something simpler:

Option Explicit

Sub sixshe_v3()
    Const n As Long = 8
    Const tbl_beg As String = "Row Labels"
    
    With ThisWorkbook.Sheets("07_Sheet")
        'Conditions
        Dim r As Range: Set r = .Cells.Find(tbl_beg, .Cells(.Rows.Count, .Columns.Count), xlValues, xlByRows)
        If r Is Nothing Then MsgBox "No data": Exit Sub
        Dim univ: univ = r.CurrentRegion.Columns.Count
        If univ < 3 Then MsgBox "Insufficient data": Exit Sub
        'Clearing up
        If univ > 3 Then .Range(r.Range("D1"), r.End(xlToRight)).EntireColumn.Delete Shift:=xlToLeft
        r.Offset(-1, 0).Resize(1, univ).Clear
        'Headings I
        r.Range("D1").Resize(1, 10).Value = Array("Row Labels", "No. of Claims", "Amount", "SOW", "No of claims (%)", _
                                                "Row Labels", "No. of Claims", "Amount", "SOW1", "No of claims (%)1")
        'Variables
        Dim c As Integer, cr, frmla
        cr = Array(0, 0, 0, -1, -3, 0, 0, 0, -9, -11)
        frmla = Array(0, 0, 0, 0, r.Row + (n + 1), 0, 0, 0, 0, r.Row + r.CurrentRegion.Rows.Count - 1)
        'Formulas
        For c = 4 To 9 Step 5
            r.Cells(2, c).Resize(n, 3).Value = r.Range("A2").Resize(n, 3).Value
            r.Cells(2, c).Offset(n, 0).Value = "Grand Total"
            r.Cells(2, c).Offset(n, 1).Resize(1, 4).FormulaR1C1 = "=SUM(R[-" & n & "]C:R[-1]C)"
            r.Cells(2, c + 3).Resize(n, 1).FormulaR1C1 = "=RC[" & cr(c - 1) & "]/R" & frmla(c) & "C[" & cr(c - 1) & "]"
            r.Cells(2, c + 4).Resize(n, 1).FormulaR1C1 = "=RC[" & cr(c) & "]/R" & frmla(c) & "C[" & cr(c) & "]"
        Next
        'Formats
        r.Copy
        r.Range("D1").Resize(1, 10).PasteSpecial xlPasteFormats: Application.CutCopyMode = False
        r.Range("A2").Resize(n + 1, 3).Copy
        r.Range("D2").Resize(n + 1, 3).PasteSpecial xlPasteFormats
        r.Range("I2").Resize(n + 1, 3).PasteSpecial xlPasteFormats: Application.CutCopyMode = False
        r.Select
        For c = 4 To 9 Step 5
            r.Range(Cells(2, c + 3), Cells(2, c + 4)).Resize(n + 1, 2).NumberFormat = "#0.00%"
        Next
        r.Range("D2").Offset(n, 0).Resize(1, 10).Font.Bold = True
        r.CurrentRegion.EntireColumn.AutoFit
        'Headings II & Formats
        r.Offset(-1, 0).Value = "Actual Data"
        r.Offset(-1, 0).Resize(1, 3).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 0).Resize(1, 3).Interior.ColorIndex = 34
        r.Offset(-1, 3).Value = "Only top %"
        r.Offset(-1, 3).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 3).Resize(1, 5).Interior.ColorIndex = 35
        r.Offset(-1, 8).Value = "On ALL"
        r.Offset(-1, 8).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 8).Resize(1, 5).Interior.ColorIndex = 36
    End With
End Sub

Half of the code is used to format the sheet.

Hey porucha vevrku,

You damn good. Thanks a ton.

Hi porucha vevrku,

I need one more. In same table I need to give some comments on table. I have added below code end of your code.

Range("E18") = "Highest is " & Range("E7") & "amount is " & Range("g7") & "percentage is " & Range("h7")
    'I have given cell reference "E18" manually. Here for "E18" instead of mannual entry, should be by code. Like, find new Grand Total cell (e15) and go down 2 cell below.
    Range("E19") = "Second Highest value is _________________ " & "Percentage is" 'here I need to give reference of cell value "E8" but giving some code like (value in column E, n - n + 2)
    Range("E20") = "third Highest value is _________"  'here I need to give reference of cell value "E8" but giving some code like (value in column E, n - n + 3)
    Range("E21") = "the total is " & Range("g15") & "precentage is " & Range("h15") & "percentage is " & Range("i15")

Similarly I have insert many comments by concatenating multiple cells.


Can you give me one blanket code to select the desired cell. so that I can use the code by changing the cell reference or range.

I mean , like
For value in Cell E7 = (column number 0 from newly copied first column (i.e. E), row number 2,) .value . Please link this with n. so that If I change constant value the code will change accordingly.

For value in Cell G7 = (column number 2 from newly copied first column (i.e. E), row number 2,) .value
For value in Cell G11 = (column number 2 from newly copied first column (i.e. E), row number 6,) .value


Also for sum column also in similar way like

Total of first sum value (F15) = (first copied column (E) + go to "Grand Total", 1).value
Total of third sum value (H15) = (first copied column (E) + go to "Grand Total", 3).value


Also for percentage
Like for value of "H8" (first copied column (E) + 3, value of n-n+2)
Like for value of "I11" (first copied column (E) + 3, value of n-n+5)

If I understood correctly, something like that ?

Option Explicit

Sub sixshe_v4()
    Const n As Long = 8
    Const tbl_beg As String = "Row Labels"
    
    With ThisWorkbook.Sheets("07_Sheet")
        'Conditions
        Dim r As Range: Set r = .Cells.Find(tbl_beg, .Cells(.Rows.Count, .Columns.Count), xlValues, xlByRows)
        If r Is Nothing Then MsgBox "No data": Exit Sub
        Dim univ: univ = r.CurrentRegion.Columns.Count
        If univ < 3 Then MsgBox "Insufficient data": Exit Sub
        'Clearing up
        If univ > 3 Then .Range(r.Range("D1"), r.End(xlToRight)).EntireColumn.Delete Shift:=xlToLeft
        r.Offset(-1, 0).Clear 'r.Offset(-1, 0).Resize(1, univ).Clear
        'Headings I
        r.Range("D1").Resize(1, 10).Value = Array("Row Labels", "No. of Claims", "Amount", "SOW", "No of claims (%)", _
                                                "Row Labels", "No. of Claims", "Amount", "SOW1", "No of claims (%)1")
        'Variables
        Dim c As Integer, cr, frmla
        cr = Array(0, 0, 0, -1, -3, 0, 0, 0, -9, -11)
        frmla = Array(0, 0, 0, 0, r.Row + (n + 1), 0, 0, 0, 0, r.Row + r.CurrentRegion.Rows.Count - 1)
        'Formulas
        For c = 4 To 9 Step 5
            r.Cells(2, c).Resize(n, 3).Value = r.Range("A2").Resize(n, 3).Value
            r.Cells(2, c).Offset(n, 0).Value = "Grand Total"
            r.Cells(2, c).Offset(n, 1).Resize(1, 4).FormulaR1C1 = "=SUM(R[-" & n & "]C:R[-1]C)"
            r.Cells(2, c + 3).Resize(n, 1).FormulaR1C1 = "=RC[" & cr(c - 1) & "]/R" & frmla(c) & "C[" & cr(c - 1) & "]"
            r.Cells(2, c + 4).Resize(n, 1).FormulaR1C1 = "=RC[" & cr(c) & "]/R" & frmla(c) & "C[" & cr(c) & "]"
        Next
        'Formats
        r.Copy
        r.Range("D1").Resize(1, 10).PasteSpecial xlPasteFormats: Application.CutCopyMode = False
        r.Range("A2").Resize(n + 1, 3).Copy
        r.Range("D2").Resize(n + 1, 3).PasteSpecial xlPasteFormats
        r.Range("I2").Resize(n + 1, 3).PasteSpecial xlPasteFormats: Application.CutCopyMode = False
        r.Select
        For c = 4 To 9 Step 5
            r.Range(Cells(2, c + 3), Cells(2, c + 4)).Resize(n + 1, 2).NumberFormat = "#0.00%"
        Next
        r.Range("D2").Offset(n, 0).Resize(1, 10).Font.Bold = True
        r.CurrentRegion.EntireColumn.AutoFit
        'Headings II & Formats
        r.Offset(-1, 0).Value = "Actual Data"
        r.Offset(-1, 0).Resize(1, 3).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 0).Resize(1, 3).Interior.ColorIndex = 34
        r.Offset(-1, 3).Value = "Only top %"
        r.Offset(-1, 3).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 3).Resize(1, 5).Interior.ColorIndex = 35
        r.Offset(-1, 8).Value = "On ALL"
        r.Offset(-1, 8).Resize(1, 5).HorizontalAlignment = xlCenterAcrossSelection
        r.Offset(-1, 8).Resize(1, 5).Interior.ColorIndex = 36
        'Summary descriptions
        With r.Range("D1")
            .Offset(n + 4, 0).Value = "1st Highest is " & """" & .Range("A2").Value & """" & ", Amount is " & .Range("C2").Text & ", Percentage is " & .Range("D2").Text
            .Offset(n + 5, 0).Value = "2nd Highest is " & """" & .Range("A3").Value & """" & ", Amount is " & .Range("C3").Text & ", Percentage is " & .Range("D3").Text
            .Offset(n + 6, 0).Value = "3rd Highest is " & """" & .Range("A4").Value & """" & ", Amount is " & .Range("C4").Text & ", Percentage is " & .Range("D4").Text
            .Offset(n + 7, 0).Value = "The Total is " & .Range("C" & n + 2).Text & ", Precentage is " & .Range("D" & n + 2).Text & ", Percentage is " & .Range("E" & n + 2).Text
        End With
        .Range("A1").Select
    End With
End Sub

This is what I exactly wanted genius.........

Hi porucha vevrku,
I need one last help from same code.

1)
If I add, more columns in sheet 07_Sheet after Coulmn D, Our code overwirtes the data.

For Example, Now I added one more column in after column "D", i.e. average. After running the code our the average column disappears.

Can you chagne the code to run after the last column in actual data. Because I might be adding more columns after after column D one after one.

But Our code and calculation is going to be same


2) 'Summary descriptions

Can you help me to add few more lines as below after exiting lines?

Total number as per Actual data is 12240 i.e. C23
Total Amount as per Actual data is 9794255 i.e. D23
Total Average as per Actual data is 800 i.e. E23

No. of Claims in only top % 6,696 i.e. G15
Amount in only top % 5,377,128 i.e. H15
SOW in only top % 100.00% i.e. I15
No of claims (%) in only top % 100.00% i.e. J15

No. of Claims in On ALL 6,696 i.e. L15
Amount in On ALL 5,377,128 i.e. M15
SOW in On ALL 54.90% i.e. N15
No of claims (%) in On ALL 54.71% i.e. O15

Ad 1. "One topic = One question", don't enlarge/expand/extend your requirements on and on/indefinitely/ad infinitum in accordance with the solutions you received. If you need solutions to your issues that appeared in an existing topic but don't fall within it, then create a new topic, the solutions of others can be many times better.
Ad 2. When it comes to "Summary descriptions", you already have the procedure scheme, just use it to extend the description fields.