CODEWITHSUNDEEP
excelvba
Broly
Broly

Reputation: 921

Transpose and paste special rows to columns

I have an excel sheet that contains data in the following format in two columns:

Category1 Sub-category1

Category1 Sub-category2

Category2 Sub-category1

Category2 Sub-category2

Category2 Sub-category3

and so on. The number of sub-categories under a category is not same, so some categories have 2 sub-categories while some have 15. I want the output in the format:

Category1 Sub-category1 Sub-category2

Category2 Sub-category1 Sub-category2 Sub-category3

For now I have added the count of sub-categories in a category in a third column and am running the following code (taken from the internet)

Sub Trans()
Dim rng As Range
Dim I As Long
Dim rng2 As Range
Dim x As Long

Set rng = Range("b1")
Set rng2 = Range("C1")
While rng.Value <> ""
    I = I + 1
    x = rng2.Value
    rng.Resize(x).Copy
    Range("E" & I).PasteSpecial Transpose:=True
    Set rng = rng.Offset(x)
Wend

End Sub

The problem is the I am not able to get the desired result as I am not able to change the value of x to reflect the count of sub-categories in a particular category. any help on this code or a new way to accomplish this would be appreciated. Thanks

Upvotes: 0

Views: 218

Answers (1)

user6432984
user6432984

Reputation:

You need to increment the row for each change in category.

Sub Trans()
    Dim rng As Range
    Dim x As Long, y As Long
    Dim category As String
    Set rng = Range("B1")
    Set rng2 = Range("C1")

    For Each rng In Range("B1", Range("B1").End(xlDown))
        If rng <> category Then
            category = rng.Value
            y = 0
            x = x + 1
            Range("E1").Offset(x - 1, y) = category
        End If
        y = y + 1
        Range("E1").Offset(x - 1, y) = rng.Offset(0, 1)
    Next

End Sub

enter image description here

Upvotes: 1

Related Questions