Solved: Transpose in diffrent rows

[lolos]

I want to Transpose Data from Columns to Rows with a feature to start a New Row for each New Record which is identified by an empty Row each data set in my column has different number of rows!
I use excel 2003
So what i want is to have each data set aaaa, bbbb, etc which is from about 7 to 20 rows and after is a blank cell to be in rows and each one starts with the first row after the blank!
thanks in advance.

1aaaa 1aaaa 2aaaa 3aaaa 4aaaa 5aaaa
2aaaa 1bbbb 2bbbb
3aaaa 1cccc 2cccc 3cccc
4aaaa
5aaaa

1bbbb
2bbbb

1cccc
2cccc
3cccc

[mikerickson]

I'm not sure if this is what you want. It will turn

a aa aaab bb
c cc ccc

into
a
aa
aaa

b
bb

c
cc
ccc

Sub test()
Dim originalRange As Range, readThisRange As Range
Dim destinationTopCell As Range
Dim dataRRay As Variant, outputRRay As Variant
Dim i As Long, j As Long, rowPointer As Long

Set originalRange = ThisWorkbook.Sheets(1).Range("a2:c3")
Set destinationTopCell = ThisWorkbook.Sheets(1).Range("d15")

Set readThisRange = originalRange.Range("a1")
For i = 1 To originalRange.Rows.Count
Set readThisRange = Range(originalRange.Cells(i, 1).EntireRow.Range("ie1").End(xlToLeft) _
, readThisRange)
Next i
dataRRay = readThisRange.Value
With readThisRange
ReDim outputRRay(1 To (UBound(dataRRay, 2) * (UBound(dataRRay, 1) + 1)))
End With
i = 1
Do
For j = 1 To UBound(dataRRay, 2)
If dataRRay(i, j) = vbNullString Then Exit For
rowPointer = rowPointer + 1
outputRRay(rowPointer) = dataRRay(i, j)
Next j
rowPointer = rowPointer + 1
i = i + 1
Loop Until i > UBound(dataRRay, 1)
ReDim Preserve outputRRay(1 To rowPointer)
With destinationTopCell
Range(.Range("a1"), .Cells(rowPointer, 1)).Value = Application.Transpose(outputRRay)
End With
End SuboriginalRange and destinationTopCell need to be changed to meet your situation.

[lolos]

i want tis column :
1aaaa
2aaaa
3aaaa
4aaaa
blank
1bb
2bb
blank
1cccc
2cccc
3cccc
blank
1wwwwww
2wwwwww
3wwwwww
blank

to become

1aaaa 2aaaa 3aaaa 4aaaa
1bb 2bb
1cccc 2cccc 3cccc
1wwwwww 2wwwwww 3wwwwww
so each new record (row) stert after the blank cell.
Now its new record has x number of cells!

[mikerickson]

This should do what you want.

Sub test2()
Dim inputColumn As Range, readThisRange As Range
Dim upLeftOutput
Dim dataRRay As Variant, outputRRay As Variant
Dim colOut As Long, rowOut As Long, readPointer As Long
Dim blankCount As Long, numColOut As Long
Set inputColumn = ThisWorkbook.Sheets("sheet1").Range("a2:a5")
Set upLeftOutput = ThisWorkbook.Sheets("sheet1").Range("b1")
Set readThisRange = Range(inputColumn.Range("a1"), _
inputColumn.Range("a1").EntireColumn.Range("a65536").End(xlUp))

On Error Resume Next
blankCount = readThisRange.SpecialCells(xlCellTypeBlanks).Cells.Count
On Error GoTo 0
dataRRay = Application.Transpose(readThisRange.Value)
ReDim outputRRay(1 To (blankCount + 1), 1 To UBound(dataRRay))
rowOut = 1
Do
For colOut = 1 To UBound(dataRRay)
readPointer = readPointer + 1
If readPointer > UBound(dataRRay) Then Exit For
If dataRRay(readPointer) = vbNullString Then Exit For
outputRRay(rowOut, colOut) = dataRRay(readPointer)
Next colOut
If numColOut < colOut Then numColOut = colOut
rowOut = rowOut + 1
Loop Until rowOut > blankCount + 1
If numColOut > UBound(dataRRay) Then numColOut = UBound(dataRRay)
With upLeftOutput.Range("a1")
Range(.Range("a1"), .Cells(blankCount + 1, numColOut)).Value = outputRRay

End With
End Sub

[lolos]

It dosent seem to work or i do somthing wrong.
I will try more and come back.
Anyhow thank you!

[mikerickson]

You may need to ajust the variables inputColumn (a range) and upLeftOutput (another range).