Transpose macro varying rows from 1 column

[tommyleinen]

I've trawled a few forums for a while now trying to find a macro that matches my specifications, or one I can adapt but so far have been unsuccessful, so here goes:

I have one column of data (col. A) of customer names and addresses each with an empty row in between them. The lines of data relating to each customer vary from 6 rows to 14 rows, then an empty row, then the next customer and so on - for several thousand rows.

I am wanting to create a macro that will transpose each customer to either their own row in sheet2, or to column B and then delete column A at the end.

All I can find is macros for a specific number of rows rather than varying. One way would be to have a code that 'pads' out those customers with fewer than 14 lines by inserting rows to make them 14, and then a code to transpose 15 rows at a time.

There are maybe a number of ways to do this but my limited knowledge leaves me with none at the moment. Hopefully some talented person out there can help?

 

[Tom Urtis]

Actually if you were to assume ascii 160 is the culprit, which it often is, a one-liner would do instead of all that:

Columns(1).Replace what:=Chr(160), Replacement:=""

 

[Tom Urtis]

The more details you provide, the better as a rule of thumb.

This you just wrote is important:
"The number of lines in my sheet is close to 130,000. Do you think this might be a factor?"

I used specialcells which has a per-iteration collection maximum of 8192 ranges. That does not necessarily mean that 130,000 rows will exceed the 8192 number, because the 8192 number depends on sets of data (areas), not the total rows. So, for example if the average count of cells in your 130,000 rows is, say 10, then that would be 13,000 areas and would exceed the 8192 number. Additional code for sets of areas would be needed if that is what we are indeed dealing with.

 

[tommyleinen]

Okay -tried both those still the same. Anyone any ideas?

 

[tommyleinen]

Yes I think the average is towards 10 - I am halving the sheet now will let you know thanks

 

[Tom Urtis]

Try this variation for starters, and with all those rows a little patience will be needed but I think this works or comes close enough for a test run:

Sub SonOfTranspozeRowz()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Dim asn$, xRow&, iCol%, xCounter&, LastRow&
Dim cell As Range, area As Range
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
asn = ActiveSheet.Name
xCounter = 1
On Error Resume Next
Sheets("zzzTranspozed").Delete
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "zzzTranspozed"
xRow = 1
With Sheets(asn)
Do
For Each area In .Range(.Cells(xCounter, 1), .Cells(xCounter + 10000, 1)).SpecialCells(2).Areas
iCol = 1
For Each cell In area
cell.Copy Cells(xRow, iCol)
iCol = iCol + 1
Next cell
xRow = xRow + 1
Next area
xCounter = xCounter + 10001
Loop While xCounter <= LastRow
End With

Columns.AutoFit
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[tommyleinen]

Thank you SO much - you guys are superstars - my problem is well and truly solved!!!