Transposing data with Loop

Luin29

New Member
Hello all,

I am hoping for some assistance with a code I have been working on. The purpose of the code is to transpose sets of data from a column that are separated by blank rows into a summary table in the same workbook. An example of what I am trying to accomplish is provided below:

 Store Item Number Sold A1 Baseballs 20 A1 Bats 5 A1 Shorts 35 A1 Volleyballs 12 A1 Tennis Rackets 15 A1 Swim Trunks 10 B16 Baseballs 22 B16 Bats 8 B16 Shorts 45 B16 Volleyballs 6 B16 Tennis Rackets 7 B16 Swim Trunks 5 B16 Gloves 2 Into this: Store Baseballs Bats Shorts Volleyballs Tennis Rackets Swim Trunks Gloves A1 20 5 35 12 15 10 -- B16 22 8 45 6 7 5 2

<tbody>
</tbody>

Here is what I have so far:

Code:
``````Dim j, jtotalrows As Integer
Dim stRange As String
Worksheets("Sheet1").Activate
jtotalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
Do While j <= jtotalrows
j = j + 1
stRange = "A" & j
stRange2 = "A" & j + 1
If Range(stRange).Text <> Range(stRange2).Text Then
Range(Range("A" & j).Offset(1, 6), Range("A" & j).End(xlDown).Offset(, 6)).Copy
jtotalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
Worksheets("Summary Table").Range("A" & j).Offset(1, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
j = j + 1
Worksheets("Sheet1").Activate
End If
Loop``````
I would appreciate any help anyone can provide.

​Thanks

Last edited:

Oeldere

Well-known Member
without VBA,

with a pivot table.

<b></b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th><th>L</th><th>M</th><th>N</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">12</td><td style=";">Store</td><td style=";">Item</td><td style=";">Number Sold</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style=";">A1</td><td style=";">Baseballs</td><td style="text-align: right;;">20</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">Som van Number Sold</td><td style=";">Kolomlabels</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style=";">A1</td><td style=";">Bats</td><td style="text-align: right;;">5</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">Rijlabels</td><td style=";">Baseballs</td><td style=";">Bats</td><td style=";">Gloves</td><td style=";">Shorts</td><td style=";">Swim Trunks</td><td style=";">Tennis Rackets</td><td style=";">Volleyballs</td><td style=";">Eindtotaal</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style=";">A1</td><td style=";">Shorts</td><td style="text-align: right;;">35</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">A1</td><td style="text-align: right;;">20</td><td style="text-align: right;;">5</td><td style="text-align: right;;"></td><td style="text-align: right;;">35</td><td style="text-align: right;;">10</td><td style="text-align: right;;">15</td><td style="text-align: right;;">12</td><td style="text-align: right;;">97</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style=";">A1</td><td style=";">Volleyballs</td><td style="text-align: right;;">12</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">B16</td><td style="text-align: right;;">22</td><td style="text-align: right;;">8</td><td style="text-align: right;;">2</td><td style="text-align: right;;">45</td><td style="text-align: right;;">5</td><td style="text-align: right;;">7</td><td style="text-align: right;;">6</td><td style="text-align: right;;">95</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style=";">A1</td><td style=";">Tennis Rackets</td><td style="text-align: right;;">15</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style=";">Eindtotaal</td><td style="text-align: right;;">42</td><td style="text-align: right;;">13</td><td style="text-align: right;;">2</td><td style="text-align: right;;">80</td><td style="text-align: right;;">15</td><td style="text-align: right;;">22</td><td style="text-align: right;;">18</td><td style="text-align: right;;">192</td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style=";">A1</td><td style=";">Swim Trunks</td><td style="text-align: right;;">10</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">20</td><td style=";">B16</td><td style=";">Baseballs</td><td style="text-align: right;;">22</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">21</td><td style=";">B16</td><td style=";">Bats</td><td style="text-align: right;;">8</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">22</td><td style=";">B16</td><td style=";">Shorts</td><td style="text-align: right;;">45</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">23</td><td style=";">B16</td><td style=";">Volleyballs</td><td style="text-align: right;;">6</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">24</td><td style=";">B16</td><td style=";">Tennis Rackets</td><td style="text-align: right;;">7</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">25</td><td style=";">B16</td><td style=";">Swim Trunks</td><td style="text-align: right;;">5</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">26</td><td style=";">B16</td><td style=";">Gloves</td><td style="text-align: right;;">2</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">27</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3,6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">Blad25</p><br /><br />

Luin29

New Member
Thanks for the suggestion of a pivot table but I will be using text that needs to be present. Below is an actual example of data that will be summarized:

 1A 09/03/15 Benzene ND<0.5 1A 09/03/15 1,1-Dichloroethane 3.3 1A 09/03/15 1,2-Dichloroethane ND<0.5 1A 09/03/15 Trichloroethene 1.1 1A 09/03/15 Vinyl Chloride ND<0.5 3C 09/06/15 1,1-Dichloroethane 5.9 3C 09/06/15 1,2-Dichloroethane ND<0.5 3C 09/06/15 Trichloroethene 3.5 3C 09/06/15 Vinyl Chloride ND<0.5

<tbody>
</tbody><colgroup><col><col><col><col></colgroup>

Into this:

 Benzene 1,1-Dichloroethane 1,2-Dichloroethane Trichloroethene Vinyl Chloride 1A 09/03/15 ND<0.5 3.3 ND<0.5 1.1 ND<0.5 3C 09/06/15 -- 5.9 ND<0.5 3.5 ND<0.5

<tbody>
</tbody><colgroup><col><col><col span="5"></colgroup>

Thanks.

Maybe like this.

kalak

Active Member
Luin29;452s[/QUOTE said:
Maybe try this.
Code:
``````Sub make_table()

Dim d1 As Object, d2 As Object, c()
Dim a, n, u1, u2
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
a = Range("A1").CurrentRegion
n = UBound(a, 1)
ReDim c(1 To n, 1 To n)

For i = 2 To n
u1 = a(i, 1)
u2 = a(i, 2)
If Not d1.exists(u1) Then d1(u1) = d1.Count + 1
If Not d2.exists(u2) Then d2(u2) = d2.Count + 1
c(d1(u1), d2(u2)) = c(d1(u1), d2(u2)) & " " & a(i, 3)
Next i

[e1] = [a1]
[e2].Resize(d1.Count) = Application.Transpose(d1.keys)
[f1].Resize(1, d2.Count) = d2.keys
With [f2].Resize(d1.Count, d2.Count)
.Value = c
.Replace "", "--", xlWhole
End With

End Sub``````

EDIT: This refers only to your opening post.
I didn't see your modified later data.
It does really help to say what you really want straightoff.

Last edited:

kalak

Active Member
Code:
``````Sub make_table2()

Dim d1 As Object, d2 As Object, c()
Dim a, n, u1, u2
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
a = Range("A1").CurrentRegion
n = UBound(a, 1)
ReDim c(1 To n, 1 To n)

For i = 1 To n
u1 = a(i, 1) & "|" & a(1, 2)
u2 = a(i, 3)
If Not d1.exists(u1) Then d1(u1) = d1.Count + 1
If Not d2.exists(u2) Then d2(u2) = d2.Count + 1
c(d1(u1), d2(u2)) = c(d1(u1), d2(u2)) & " " & a(i, 4)
Next i

[i1].Resize(1, d2.Count) = d2.keys
With [i2].Resize(d1.Count, d2.Count)
.Value = c
.Replace "", "--", xlWhole
End With
With [g2].Resize(d1.Count)
.Value = Application.Transpose(d1.keys)
.TextToColumns Destination:=[g2], DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, OtherChar:="|", _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
End With

End Sub``````

Luin29

New Member
Thank you kalak, this is great! This code will help me with my current project and I look forward to dissecting the code to become more literate in VBA.

One more question: If I wanted the destination of this transposed summary table to be in a different worksheet, where would I place that line of code?

kalak

Active Member
Thank you kalak, this is great! This code will help me with my current project and I look forward to dissecting the code to become more literate in VBA.

One more question: If I wanted the destination of this transposed summary table to be in a different worksheet, where would I place that line of code?
Try the modifications in red
Rich (BB code):
``````Sub make_table3()

Dim d1 As Object, d2 As Object, c()
Dim a, n, u1, u2, x
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
a = Range("A1").CurrentRegion
n = UBound(a, 1)
ReDim c(1 To n, 1 To n)

For i = 1 To n
u1 = a(i, 1) & "|" & a(1, 2)
u2 = a(i, 3)
If Not d1.exists(u1) Then d1(u1) = d1.Count + 1
If Not d2.exists(u2) Then d2(u2) = d2.Count + 1
c(d1(u1), d2(u2)) = c(d1(u1), d2(u2)) & " " & a(i, 4)
Next i

Sheets("sheet2").Activate   'CHANGE THIS DESTINATION TO WHEREVER YOU LIKE
[i1].Resize(1, d2.Count) = d2.keys
With [i2].Resize(d1.Count, d2.Count)
.Value = c
.Replace "", "--", xlWhole
End With
With [g2].Resize(d1.Count)
.Value = Application.Transpose(d1.keys)
For Each x In .Cells
x.Resize(, 2) = Split(x, "|")
Next x
End With

End Sub``````

Last edited:

Luin29

New Member
Thank you. The code worked great.

1,081,981
Messages
5,362,535
Members
400,679
Latest member
alecalec202

This Week's Hot Topics

• populate from drop list with multiple tables
Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
• Find list of words from sheet2 in sheet1 before a comma and extract text vba
Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
• Dynamic Formula entry - VBA code sought
Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...