adding sums and organizing data

[ksnapp]

I have no idea where to even start with this. I hope you fine peopl
can help.

Here is an analogy to my data

chicken 3 2
pork 4 6
chicken 8 7
beef 2 7
beef 5 6
pork 6 5

the words(discription) in column A and then numbers are in column b an
column c

I need to select a vertical range of these and have a sub that adds th
numbers with the same discription and then replaces what is on th
sheet with the list created in an order I specify.

what I need would look like this:

pork 10 11
chicken11 9
beef 7 13

any ideas are greatly appreciate

 

[teatree]

there are probably more elegant solutions to this, but this will wor
without a lot of trouble on your part.

i would take three cells on the worksheet and place a subtotal formul
in them for each of the three columns, something like:

=SUBTOTAL(9,C3:C8)

the 9 comma in (9, cell1:cell2) is important, as it tells subtotal t
total only the VISIBLE Cells.

then i would write a macro that applies an autofilter to the firs
column, and then copies the values in your formula cells to your targe
worksheet...

Sub TestMePlease()
Dim count As Integer
Dim animal As String
Dim lastrow As Integer
Dim home As String
Dim target As String


On Error Resume Next

home = ActiveWorkbook.ActiveSheet.Name
Sheets.Add
target = ActiveWorkbook.ActiveSheet.Name

Sheets(home).Activate
'this assumes that youve nothing in row 1,
'and column headers in row 2
'data begins in row 3 in this illustration

' find the last row containing data
lastrow = Range("A3").End(xlDown).Row

' use that last row value to create the subtotal formulas
Range("B1").Formula = "=SUBTOTAL(9,B3:B" & lastrow & ")"
Range("C1").Formula = "=SUBTOTAL(9,C3:C" & lastrow & ")"

count = 1

Do Until count = 4

Select Case count
Case "1"
animal = "pork"
Case "2"
animal = "beef"
Case "3"
animal = "chicken"
End Select

Selection.AutoFilter Field:=1, Criteria1:=animal

Range("B1:C1").Copy

Sheets(target).Activate

Range("A" & count).Value = animal
Range("B" & count).PasteSpecial Paste:=xlValues

Sheets(home).Activate
Selection.AutoFilter

count = count + 1

Loop

End Su

 

[Greg Wilson]

Select only the descriptions before running the macro.

Sub MeatTotals()
Dim Rng As Range, C As Range
Dim Arr() As String
Dim i As Integer, ii As Integer
Dim Tot1 As Double, Tot2 As Double
Dim OnList As Boolean

i = 0: OnList = False
Tot1 = 0: Tot2 = 0
Set Rng = Selection
ReDim Arr(1)
Arr(0) = Rng(1)

For Each C In Rng.Cells
For ii = 0 To UBound(Arr)
If C = Arr(ii) Then OnList = True
Next
If OnList = False Then
i = i + 1
ReDim Preserve Arr(i)
Arr(i) = C
End If
OnList = False
Next

For i = 0 To UBound(Arr)
For Each C In Rng
If C = Arr(i) Then
Tot1 = Tot1 + C.Offset(, 1)
Tot2 = Tot2 + C.Offset(, 2)
End If
Next C
Cells(i + 1, 4) = Arr(i)
Cells(i + 1, 5) = Tot1
Cells(i + 1, 6) = Tot2
Tot1 = 0: Tot2 = 0
Next i
Rng.Resize(Rng.Rows.Count, 3).Delete Shift:=xlToLeft

End Sub

Regards,
Greg

 

[Greg Wilson]

This can also be done using array funcitons and dynamic
named ranges. This method does not require execution of a
macro but is automatic. Down sides are that you need to
know the descriptions ahead of time and enter them into a
range of cells. The array formula can then reference
these cells. You'll need to construct a formula for each
description. You also cannot delete the original data.
Named ranges can also get corrupted by cutting and pasting
and/or adding and deleting rows and columns - at least in
my experience. This is not to say that this method
shouldn't be considered.

It's also probably possible to do what you want with a
Pivot Table. I've very little experience with these and
will leave the subject to others.

By the way, in my macro, the line:
"ReDim Arr(1)" should have been "ReDim Arr(0)" although it
will still work.

Regards,
Greg

 

[Frank Kabel]

Hi
I'd strongly recommend using pivot tables for this (if I understood
your example data correctly). No need for macros/functions in this
case. See the following sites as a starting point how to create pivot
tables:
http://www.cpearson.com/excel/pivots.htm
http://peltiertech.com/Excel/Pivots/pivotstart.htm
http://www.contextures.com/xlPivot02.html