Marco to generate a summary list from a data

[et]

Hi all,

I have a data list its volume is uncertain each time, I would like to make a
summary on another sheet which can show the total of each product type from
the data list. Since I don't know what product will be shown on the data
list, I cannot predefine the product type on the summary sheet (and I don't
want to use pivot table as I need to reset the area each time). Is there any
formula or marco can do this job automatically for me, thanks in advance for
your advice.

et

Data List
Type Unit Px Qty Total
Orange 1.00 5 5.00
Orange 1.00 4 4.00
Apple 1.50 3 4.50
Orange 1.00 16 16.00
Banana 1.60 17 27.20
Apple 1.50 18 27.00
Banana 1.60 19 30.40

Summary
Type Unit Px Qty Total
Orange 25 25
Apple 21 32
Banana 36 58
Total ¡@ 82 114

 

[kemal]

I wonder what kind of code or formula can beat a Pivot table on this
issue.
Please visit Debra's site at Contextures.

 

[Udo]

Sometimes it is feasible to have e.g. the sums sent directly to
another application or to convert the data into an invoice.
My suggestion to cope with the problem using VBA would be: Make sure
that the cursor is placed somewhere within the region of interest.
Check out the first and the last line (and put them into variables).
Go to the last column, select the cell below the last row of this
column as ActiveCell and write into this cell the code to sum all
numbers in this column from the first to the last row.
If needed, I can supply you with the complete code and how to run it.

 

[Bob Phillips]

Option Explicit

Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim iLastRow As Long
Dim i As Long
Dim iPos As Long
Dim sh As Worksheet
Dim iRow As Long
Set sh = Worksheets("Sheet3") '<=== change to suit
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
iRow = 1
For i = 1 To iLastRow
iPos = 0
On Error Resume Next
iPos = Application.Match(.Cells(i, TEST_COLUMN).Value,
sh.Columns(1), 0)
On Error GoTo 0
If iPos = 0 Then
.Rows(i).Copy sh.Cells(iRow, 1)
sh.Cells(iRow, 2).Value = ""
iRow = iRow + 1
Else
sh.Cells(iPos, 3).Value = sh.Cells(iPos, 3).Value + _
.Cells(i, TEST_COLUMN).Offset(0, 2).Value
sh.Cells(iPos, 4).Value = sh.Cells(iPos, 4).Value + _
.Cells(i, TEST_COLUMN).Offset(0, 3).Value
End If
Next i
sh.Cells(iRow, 1).Value = "Total"
sh.Cells(iRow, 3).Formula = "=SUM(C2:C" & iRow - 1 & ")"
sh.Cells(iRow, 4).Formula = "=SUM(D2" & iRow - 1 & ")"
End With
End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[et]

Thankyou.

Option Explicit

Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim iLastRow As Long
Dim i As Long
Dim iPos As Long
Dim sh As Worksheet
Dim iRow As Long
Set sh = Worksheets("Sheet3") '<=== change to suit
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
iRow = 1
For i = 1 To iLastRow
iPos = 0
On Error Resume Next
iPos = Application.Match(.Cells(i, TEST_COLUMN).Value,
sh.Columns(1), 0)
On Error GoTo 0
If iPos = 0 Then
.Rows(i).Copy sh.Cells(iRow, 1)
sh.Cells(iRow, 2).Value = ""
iRow = iRow + 1
Else
sh.Cells(iPos, 3).Value = sh.Cells(iPos, 3).Value + _
.Cells(i, TEST_COLUMN).Offset(0, 2).Value
sh.Cells(iPos, 4).Value = sh.Cells(iPos, 4).Value + _
.Cells(i, TEST_COLUMN).Offset(0, 3).Value
End If
Next i
sh.Cells(iRow, 1).Value = "Total"
sh.Cells(iRow, 3).Formula = "=SUM(C2:C" & iRow - 1 & ")"
sh.Cells(iRow, 4).Formula = "=SUM(D2" & iRow - 1 & ")"
End With
End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

 

[et]

Thankyou for your advice.

Sometimes it is feasible to have e.g. the sums sent directly to
another application or to convert the data into an invoice.
My suggestion to cope with the problem using VBA would be: Make sure
that the cursor is placed somewhere within the region of interest.
Check out the first and the last line (and put them into variables).
Go to the last column, select the cell below the last row of this
column as ActiveCell and write into this cell the code to sum all
numbers in this column from the first to the last row.
If needed, I can supply you with the complete code and how to run it.