SUMIF as a macro in Excel (VBA)

Question

So this is the concept I'm working with.

I have Sheet1 with many keys and values on it:

Then on sheet2 I have been using a SUMIF function to work out the total values from sheet1:

This is just an example and the actual datasets are much larger. I need to design a macro that will automatically generate and insert the SUMIF formula into the correct cells in sheet2. Can anyone think of a way to do this?

Answer 1

Even without knowing any other requirements or what you're doing or how many columns or keys there are or anything else, you can:

1. record a macro,
2. assign it to a button,
3. write one line of code so that when user clicks button it will run macro on the column selected (or when first cell of column is selected).

If there are 100+ columns then yea it's tedious and you'd want a macro to loop through it all but I have no idea what you got/need.

Answer 2

Here is a solution.

With [sheet1!a1:index(sheet1!a:a,count(sheet1!a:a))]

    [b1:index(sheet2!b:b,count(sheet2!a:a))].Offset(1).Formula = _
        "=sumif(sheet1!" & .Offset(1).Address & ",a2,sheet1!" & .Offset(1, 1).Address & ")"

End With

This assumes that the column A on sheet2 is already in place. Likewise it assumes that the Header for column B on sheet2 is already in place, and that the rest of column B is blank and will be filled by the above code.

It also assumes numeric keys.

This solution can easily be adjusted if any assumptions are wrong. Just let me know.

Answer 3

I would read the data up from sheet one and then build the second sheet. You will need to add a reference for the adodb recordset. In the VBA IDE on the tools pulldown menu select references. Select "Microsoft ActiveX Data Objects 2.8 Library".

Private Sub CommandButton10_Click()
Dim rs As New ADODB.Recordset
Dim ws As Excel.Worksheet
Dim lRow As Long
Dim lLastRowSheet1 As Long

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    'Add fields to your recordset for storing data.
    With rs
        .Fields.Append "Row", adInteger
        .Fields.Append "Key", adInteger
        .Fields.Append "Val", adInteger
        .Open
    End With

    lLastRowSheet1 = ws.UsedRange.Rows.count
    lRow = 1

    'Loop through and record what is in the columns
    Do While lRow <= ws.UsedRange.Rows.count

        rs.AddNew
        rs.Fields("Row").Value = lRow
        rs.Fields("Key").Value = ws.Range("A" & lRow).Value
        rs.Fields("Val").Value = ws.Range("B" & lRow).Value
        rs.Update

        lRow = lRow + 1
        ws.Range("A" & lRow).Activate
    Loop

    If rs.EOF = False Then
        rs.MoveFirst
    End If

    'Switch to the second worksheet
    Set ws = Nothing
    Set ws = ActiveWorkbook.Sheets("Sheet2")

    'Now go through the data from sheet one and build the list of keys
    Dim iLastKey As Integer
    lRow = 1
    Do While rs.EOF = False
        'For each unique key add a row to the second sheet.
        If rs.Fields("Key").Value <> iLastKey Then
            ws.Range("A" & lRow).Value = rs.Fields("Key").Value
            ws.Range("B" & lRow).Formula = "=sumif(sheet1!$A$2:$A$" & lLastRowSheet1 & ",A" & lRow & ",Sheet1!$B$2:$B$" & lLastRowSheet1 & ")"
           lRow = lRow + 1
        End If

        iLastKey = rs.Fields("Key").Value
    rs.MoveNext
    Loop

End Sub

Answer 4

This is what I used in the end:

Sub GetKeyVals()

' GetKeyVals Macro
' Get the key values based on the Unique customer codes

' Define sheet
Dim Extract As Worksheet
Set Extract = ActiveSheet

'Define lastRow
Dim lastRow As Long
lastRow = Extract.Cells(Rows.Count, "A").End(xlUp).row

' Loop round all rows
Dim n As Long

For n = 2 To lastRow
    Cells(n, 3).FormulaR1C1 = _
        "=SUMIF(SAPDump!R2C8:R1317C8,Extract!RC[-1],SAPDump!R2C10:R1317C10)*-1"
    Range("C3").Select
Next n

' Insert Title

Dim Txt As Range
Set Txt = ActiveSheet.Range("C1")
Txt.Value = "KeyValue"
Txt.Font.Bold = True

End Sub

The problem is it's really slow, does anyone know a way of making this run any faster? cheers