CODEWITHSUNDEEP
excelvba
credenco
credenco

Reputation: 287

How to calculate directly with VBA in Table

I am trying to calculate directly in Excel.

Steps: -Make new table without duplicates from Table1(Dates) -Get the headers from the values in Done -Sum if date and name are equal

Here an example of the solution with a formula.

enter image description here

I know hot to solve this with cFormula but i couldnt find a fast and "easy to code" solutiuon directly with vba.


Dim sbl As ListObject: Set sbl = ActiveWorkbook.Sheets(4).ListObjects("Tab_1") 'source table
Dim tbl As ListObject: Set tbl = ActiveWorkbook.Sheets(4).ListObjects("Tab_2") 'target table


MsgBox Application.WorksheetFunction.SumIfs(sbl.ListColumns(2).DataBodyRange, sbl.ListColumns(2).DataBodyRange)


End Sub

I got his. But i couldnt find otu how to write in the column "Peter"

Can someone help me plz or give me an information.

Upvotes: 0

Views: 499

Answers (1)

Elio Fernandes
Elio Fernandes

Reputation: 1420

I found a solution, hope it fits your need!

enter image description here

Sub AddFormulaAndCopyToValues2()
    Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets(1)
    Dim sbl As ListObject: Set sbl = ws.ListObjects("Tab_1")    'source table
    Dim tbl As ListObject: Set tbl = ws.ListObjects("Tab_2")    'target table
    
    Dim tblRow As Integer: tblRow = tbl.Range.Row               ' first row
    Dim tblCol As Integer: tblCol = tbl.Range.Column            ' first Column
    
    Dim dateRng As Range: Set dateRng = sbl.ListColumns("Date").DataBodyRange
    Dim doneRng As Range: Set doneRng = sbl.ListColumns("Done").DataBodyRange
    
    ' set rng to insert formula
    Dim frmRng As Range: Set frmRng = tbl.ListColumns(2).DataBodyRange.Resize(tbl.ListRows.Count, 3)
        
    ' set rng to insert formula
    Dim rCell As Range: Set rCell = tbl.HeaderRowRange(2, 2)
    
    ' Do calculations
    Dim dateVal As Variant
    Dim nameVal As String
    For Each rCell In frmRng
        dateVal = Cells(rCell.Row, tblCol).Value
        nameVal = Cells(tblRow, rCell.Column).Value
        rCell.Formula2R1C1 = Application.WorksheetFunction.CountIfs(dateRng, dateVal, doneRng, nameVal)
    Next rCell
End Sub

Upvotes: 1

Related Questions