Looking for an Automated & Smart Transpose solution

[Gumsolmao]

So currently, per the title, I'm looking to make a smart and relatively automatic transpose system.

So far the only way ive figured out how to do this is with macros, paste special, and a lot of manual work (working on 2,000~ row sheet).

The following example is an example.
All the events belong to A1 but are distributed downwards in a new row. The goal is to have them all in a single row (either in a single cell or adjacent).

A	1	Event 1
		Event 2
		Event 3
B	2	Group 1

All the events belong to A1 but are distributed downwards in a new row. The goal is to have them all in a single row (either in a single cell or adjacent).
The example of how I need them is demonstrate below.

A	1	Event 1	Event 2	Event 3
B	2	Group 1

I have searched far and wide and haven't found anything which solves this bizarre request.

[im.zeeshan]

I'm assuming your data starts from Cell A1.

Just add a row with hyphens to mark the end of the data sheet like;

A	1	Event 1
		Event 2
		Event 3
B	2	Group 1
		Group 2
-	-	-

Then run the following macro: (Your results will be displayed in Sheet 2)

Sub SmartTranspose()
    j = 1
    For nRow = 1 To Sheets(1).UsedRange.Count
        If nRow = 1 Then
            sCategory = Cells(nRow, 1).Value
            sSubCategory = Cells(nRow, 2).Value
            sItem = Cells(nRow, 3).Value
        Else
            If Cells(nRow, 2).Value = "" Then
                sItem = sItem & ";" & Cells(nRow, 3).Value
            Else
                aItem = Split(sItem, ";")
                Sheets(2).Cells(j, 1) = sCategory
                Sheets(2).Cells(j, 2) = sSubCategory
                c = 3
                For x = 0 To UBound(aItem)
                    Sheets(2).Cells(j, c) = aItem(x)
                    c = c + 1
                Next
                sCategory = Cells(nRow, 1).Value
                sSubCategory = Cells(nRow, 2).Value
                sItem = Cells(nRow, 3).Value
                j = j + 1
            End If
        End If
    Next

End Sub

[arlu1201]

Try this code

Sub transpose()
Dim i As Long, lrow As Long, lcol As Long, lcol1 As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("A" & i).Value = "" Then
            lcol = .Range("IV" & i - 1).End(xlToLeft).Column
            lcol1 = .Range("IV" & i).End(xlToLeft).Column
            .Range(.Cells(i, 2), .Cells(i, lcol1)).Copy .Cells(i - 1, lcol + 1)
            Application.CutCopyMode = False
            .Rows(i).Delete
        End If
    Next i
End With

MsgBox "Done"

Application.ScreenUpdating = True

End Sub

[Gumsolmao]

I swear to god this place is full of witchcraft, thank you both so much.