Table "summary"

sabsx

New Member
Joined
Jul 24, 2007
Messages
26
hi!

Currently I have another problem... I want to summarize all products of an offer in one table row... at the moment I get several rows the same offer number...

example:

the original data look like this:
<table cellpadding="5" cellspacing="5" border="1">
<tr><td>offer nr</td><td>item nr</td><td>item</td> </tr>
<tr><td>1</td><td>1</td><td>flowers</td> </tr>
<tr><td>1</td><td>2</td><td>vegetables</td> </tr>
<tr><td>2</td><td>1</td><td>chocolate</td> </tr>
</table>

and I want to have a table or a pivot table like this:
<table cellpadding="5" cellspacing="5" border="1">
<tr>
<td>offer nr</td><td>items</td> </tr>
<tr><td>1</td><td>flowers, vegetables</td> </tr>
<tr><td>2</td><td>chocolate</td> </tr>
</table>

how can this be made?

all the best,

sabsx
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
try
Code:
Sub test()
Dim a, b(), i As Long, n As Long
a = Range("a1").CurrentRegion.Resize(,3).Value
ReDim b(1 To UBound(a,1), 1 To 2)
With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a,1)
          If Not .exists(a(i,1)) Then
                 n = n + 1 : b(n,1) = a(i,1) : b(n,2) = a(i,3)
                 .add a(i,1), n
          Else
                b(.item(a(i,1)), 2) = b(.item(a(i,1)), 2) & ", " & a(i,3)
          End If
     Next
End With
Range("e1").Resize(n,2).Value = b
End Sub
 
Upvote 0
I think this does not work properly... I created a test sheet with numbers in column A and different things ins column B. When I execute this macro, I get the numbers once (as it should be) in column E and just commas (,) in column F.
 
Upvote 0
I think this does not work properly... I created a test sheet with numbers in column A and different things ins column B. When I execute this macro, I get the numbers once (as it should be) in column E and just commas (,) in column F.

That's because your actual sheet layout is different from yoour sample.

You need to adjust the code, otherwise explain which column has which data.
 
Upvote 0
ah ok...

I have got the numbers in column C, the things which should have commas in column K, the price which should be added in column BJ and all data reach till column BY. Is it possible to copy the result in a new sheet?

thanks for your help!
 
Upvote 0
ah ok...

I have got the numbers in column C, the things which should have commas in column K, the price which should be added in column BJ and all data reach till column BY. Is it possible to copy the result in a new sheet?

thanks for your help!
Not clear,
What I understand from your sample is list all the Items for each unique offer nr, so I ignored item nr.

What is Price??
 
Upvote 0
sorry I'm a bit confused... I forgot to mention the items have a price...
maybe I can put in another words...
as long as the offer number stays the same, the items should be put together and the price of the items should be added up and all should be written in a new table... item number and some other things can be ignored... and I'd need a blank column at the beginning of the new table...
is it a bit more clear now?
 
Upvote 0
sabsx

Please provide a sample with the actual sheet layout(data is not matter) for the next time.

If you think you can adjust the given code, you should be able to write it somehow already.
Let's see if this works
Code:
Sub test()
Dim OffNr, myItem, myPrice, i As Long, b(), n As Long
With Range("c1", Range("c" & Rows.Count).End(xlUp))
     OffNr = .Value
     myItem = .Offset(,8).Value
     myPrice = .Offset(,59).Value
End With
ReDim b(1 To UBound(OffNr,1), 1 To 3)
With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(OffNr,1)
          If Not IsEmpty(OffNr(i,1)) Then
               If Not .exists(OffNr(i,1)) Then
                    n = n + 1
                    b(n,1) = OffNr(i,1) : b(n,2) = myItem(i,1) : b(n,3) = myPrice(i,1)
                   .add OffNr(i,1), n
               Else
                    x = .item(OffNr(i,1))
                    b(x,2) = b(x,2) & ", " & myItem(i,1)
                    b(x,3) = b(x,3) + myPrice(i,1)
               End If
          End If
     Next
End With
On Error Resume Next
Application.DisplayAlerts = False
Sheets("result").Delete
Application.DicplayAlerts = True
Sheets.Add.Name = "result"
Sheets("result").Range("b1").Resize(n,3).Value = b
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,286
Messages
6,171,190
Members
452,390
Latest member
kemafa77

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top