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:
<tbody>
</tbody>
Here is what I have so far:
I would appreciate any help anyone can provide.
Thanks
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: