SUMIF as a macro in Excel (VBA) - 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:
record a macro,
assign it to a button,
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