Table "summary"

[sabsx]

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

 

[jindon]

try

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

 

[sabsx]

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.

 

[jindon]

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.

 

[sabsx]

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!

 

[jindon]

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??

 

[sabsx]

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?

 

[jindon]

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

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

 

[sabsx]

I get an error "sub or function not defined"...

 

[jindon]

OK

I found a typo and already edited the code.

Can you copy again and try?