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

 

[sabsx]

works!

thanks a million!

how can I post sample data for the next time?

 

[jindon]

Use colo's HTML maker, or you can even explain in words using actual column(s).

 

[sabsx]

ok... and how can I display further columns with this macro? I have very basic programming skills so I'm trying to learn and understand your code...

 

[jindon]

Ahhh, did you want just add all same OffNr in BY and display other columns as well?

Then I need the columns of data range.

Is it from col.A to col.BY? or just from Col.C to col.BY?

 

[sabsx]

I just want to extend the working solution with a few more columns of the data... nothing has to be done with this column (no add up or something) - I just want to have the columns I, Z, AG, BC, BD in the result list too...

 

[jindon]

If you want to study this code
While you are in VBEditor
1) go to [View] - [LocalWindow]
2) Click somewhere on the code
3) As you hit F8, the code will execute line by line
4) at the same time, you will see all the variables in the Local Window
5) you can see inside of the array, if you click on "+" sign

Sub test()
Dim a, i As Long, b(), n As Long
a =  Range("c1", Range("c" & Rows.Count).End(xlUp)).Resize(,60).Value
ReDim b(1 To UBound(a,1), 1 To 7)
With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a,1)
          If Not IsEmpty(a(i, 1)) Then
               If Not .exists(a(i, 1)) Then
                    n = n + 1
                    b(n,1) = a(i,1) : b(n,2) = a(i, 7) : b(n,3) = a(i, 8) : b(n,4) = a(i,31)
                    b(n,5) = a(i,53) : b(m,6) = a(i,54) :b(n,7) = a(i,60)
                   .add a(i,1), n
               Else
                    x = .item(a(i,1))
                    b(x,3) = b(x, 3) & ", " & a(i, 8)
                    b(x,7) = b(x,7) + a(i,60)
               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,7).Value = b
End Sub

 

[sabsx]

hi!

I get a runtime error 13 "types incompatible" when I try the last code...

 

[jindon]

Typo in 2 places, fixed already...

 

[sabsx]

get another error when I execute it step by step there is a problem with = a(i, 54): b(n, 7) = a(i, 60) - it says out of index...

 

[jindon]

typo

Can you change

b(m,6) = a(i, 54) to b(n,6) = a(i,54)