VBA Help - Create sum formula

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
820
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Need vba help to Generate only Sum formula like'=SUM(B2+B4+B8)

Column A is Player Name and Column B is Salary.
Criteria List is in Column E.

Task is to find first Criteria Sachin if found. pick his salary. B2
Task is to find Second Criteria Dhoni if found. pick his salary. B4
Task is to find third Criteria Peterson if found. pick his salary.B8


Expected Output =Sum(b2+b4+b8)

how to achieve this task using vba. User want same formula.

Below is Table and Criteria
Book4
ABCDE
1Player NameSalaryCriteria
2Sachin13662Sachin
3Dhoni17968Dhoni
4Virat12951Peterson
5Sehwag16277
6
7
8Peterson13924
9
10Total40537=SUM(B2+B4+B8)
Sheet1
Cell Formulas
RangeFormula
B10B10=SUM(B2+B4+B8)


Thanks
mg
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

mehidy1437

Active Member
Joined
Nov 15, 2019
Messages
257
Office Version
  1. 2013
Platform
  1. Windows
  2. Mobile
  3. Web
Criteria will be always in the E column & always 3 criteria?
 

VBasic2008

Board Regular
Joined
Oct 25, 2016
Messages
88
Office Version
  1. 2019
Platform
  1. Windows
Create Sum Formula

  • This is a fully automated solution using the Worksheet Change event. You don't run anything.
  • If you want to run it manually then use the getCalcSumManually procedure.
  • Although it is adjusted to your current setup, carefully read through the constants section in the procedure calcSum and modify if necessary.
  • It will start running the first time you change a value in column E(CriteriaColumn).

Copy the following code (four procedures) into a standard module, e.g. Module1.

VBA Code:
Option Explicit

Public Const CriteriaColumn As String = "E" ' because of automation

Sub getCalcSumManually()
    
    Const wsName As String = "Sheet1"
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    Dim ws As Worksheet
    Set ws = wb.Worksheets(wsName)
    calcSum ws

End Sub

' If you need the result (not the formula) then outcomment the three lines
' containing 'FResult' and uncomment the three lines containing 'Result'.
Sub calcSum(Sheet As Worksheet)
    Const FirstRow As Long = 2              ' First Row Number
    Const cLR As Variant = "A"              ' Last Row Column Index
    Const cLRCriteria As String = "Total"   ' Last Row Column Criteria
    Const cLRRowOffset As Long = -2         ' Last Row Column Row Offset
    Const TargetCol As Variant = "D"        ' Target Column Index
    Dim Cols As Variant                     ' Columns Array
    ' 'VBA' to ensure 0-based.
    Cols = VBA.Array("A", "B", CriteriaColumn)
    
    ' Write values from column ranges to arrays.
    
    ' Find the cell two rows above ('-2','cLRColOffset') the last cell
    ' containing "Total" ('cLRCriteria') in column "A" ('cLR').
    Dim LastCell As Range
    getLastCellInColumn LastCell, Sheet, cLR, cLRRowOffset, , cLRCriteria
    ' Define Last Row Column Range
    Dim rng As Range
    Set rng = Sheet.Range(Sheet.Cells(FirstRow, Cols(0)), LastCell)
    ' Define Jagged Columns Array (the same size as Columns Array).
    Dim Data As Variant
    ReDim Data(0 To 2)
    ' Write values from Column Ranges to arrays of Column Array.
    Dim j As Long
    ' Backwards to exit as soon as possible if no data in 'E' column.
    For j = 2 To 0 Step -1
        getColumnRange Data(j), rng.Offset(, Sheet.Columns(Cols(j)) _
                                            .Column - rng.Column)
        If IsEmpty(Data(j)) Then GoTo ProcExit
    Next j
    
    ' Calculate result.
    
    ' Additional variables for the 'For Next' loop.
    Dim CurrIndex As Variant
    'Dim Result As Double
    Dim FResult As String
    Dim i As Long
    
    ' Calculate result.
    For i = 1 To UBound(Data(2)) ' or 0 or 1
        If Not IsEmpty(Data(2)(i, 1)) Then
            ' Try to find the current name from 'E' column in 'A' column.
            CurrIndex = Application.Match(Data(2)(i, 1), Data(0), 0)
            If Not IsError(CurrIndex) Then
                'Result = Result + Data(1)(CurrIndex, 1)
                FResult = FResult & "+" & Cols(1) & CStr(CurrIndex + FirstRow - 1)
            End If
        End If
    Next i
    
    ' Write result.
    
    ' Define Resulting Cell.
    Dim cLRColOffset As Long                ' Last Row Column Column Offset
    cLRColOffset = Sheet.Columns(TargetCol).Column - Sheet.Columns(cLR).Column
    getLastCellInColumn LastCell, Sheet, cLR, , cLRColOffset, cLRCriteria
    ' Write Result to Resulting Cell.
    'LastCell.Value = Result
    LastCell.Formula = "=SUM(" & Right(FResult, Len(FResult) - 1) & ")"
    ' You actually don't need 'SUM' and the parentheses at all
    ' to make the formula work. Think about it.
    
ProcExit:
    
End Sub

' Writes the values of a column range to a 2D one-based array.
Sub getColumnRange(ByRef Data As Variant, _
                   ColumnRange As Range)
    
    Data = Empty
    If ColumnRange Is Nothing Then
        GoTo ProcExit
    End If
    
    If ColumnRange.Rows.Count > 1 Then
        ' Column Range contains multiple cells.
        Data = ColumnRange.Value
    Else
        ' Column Range contains one cell.
        ReDim Data(1 To 1, 1 To 1)
        Data(1, 1) = ColumnRange.Value
    End If
    
ProcExit:
End Sub

' Gets the last cell in a column containing a specified criteria
' with an applied offset.
Sub getLastCellInColumn(ByRef LastCell As Range, _
                        Optional Sheet As Worksheet = Nothing, _
                        Optional ByVal ColumnIndex As Variant = 1, _
                        Optional ByVal RowOffset As Long = 0, _
                        Optional ByVal ColumnOffset As Long = 0, _
                        Optional ByVal Criteria As Variant = "*")

    If Sheet Is Nothing Then
        Set Sheet = ActiveSheet
    End If
    
    If Criteria = "*" Then
        Set LastCell = Sheet.Columns(ColumnIndex) _
                            .Find(What:="*", _
                                  LookIn:=xlFormulas, _
                                  SearchDirection:=xlPrevious) _
                            .Offset(RowOffset, ColumnOffset)
    Else
        Set LastCell = Sheet.Columns(ColumnIndex) _
                            .Find(What:=Criteria, _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlWhole, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=True) _
                            .Offset(RowOffset, ColumnOffset)
   End If

End Sub

Copy the following code (1 procedure) into a sheet module, e.g. Sheet1.

VBA Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' This is poorly handled because it will happen even if below last cell.
    If Not Intersect(Target, Columns(CriteriaColumn)) Is Nothing Then
        calcSum Me
    End If
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,653
Office Version
  1. 365
Platform
  1. Windows
Why not just use
Excel Formula:
=SUM(SUMIFS(B2:B8,A2:A8,E2:E4))
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
820
Office Version
  1. 2010
Platform
  1. Windows
Hi Fluff,

Both solution provided are right, but I forgot to mention that my Criteria list are in closed workbooks Mapping sheet.

not in a single input file with criteria.

Task is to find first Criteria Sachin if found. pick his salary. B2
Task is to find Second Criteria Dhoni if found. pick his salary. B4
Task is to find third Criteria Peterson if found. pick his salary.B8

'=sum(b2+B4+B8) and so on as per criteria list , needs looping finding each cell, storing cell address in it and later sum it.



Thanks
mg
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,484
Office Version
  1. 365
Platform
  1. Windows
... but I forgot to mention ...
I am noticing comments similar to this in quite a few of your threads. I remind you of point 5.a. of the Guidelines

... make it as easy as you can for people to help you.
a. State your question clearly, including your entire need at the start.
People may tire of helping you if they continually put effort into making a suggestion only to find it was time wasted because the full information was not provided. ;)
 

Watch MrExcel Video

Forum statistics

Threads
1,118,295
Messages
5,571,390
Members
412,386
Latest member
Yasaman
Top