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?

 

[GTO]

I see that there's a blank row between ea, that may be of use.

Could you post example before and after sample data using MrExcelHtml or ExcelJeanie?

Mark

 

[Tom Urtis]

See if this does what you want:

Sub TranspozeRowz()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Dim asn$, xRow&, iCol%, cell As Range, area As Range
asn = ActiveSheet.Name
On Error Resume Next
Sheets("zzzTranspozed").Delete
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "zzzTranspozed"
xRow = 1
For Each area In Sheets(asn).Columns(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
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[tommyleinen]

Thanks for the v.fast responses, I tried the macro you suggested and it came out different to how I need I think because the Qu was slightly ambiguous... It puts the customer records all on one row whereas I need each customer on a seperate row one on top of the other.

Eg.

Mr x
72 any street
anytown
postcode
phone number
email

Mrs Y
anyhouse
anytown2
anyvillage
postcode2
phone number2
mobile number
email2

will become:
Mr X / 72 anystreet / anytown / postcode/ ....
Mrs Y / anyhouse / anytown 2 / anyvillage / postcode2 / phone number2...
Next customer....
next customer...


I hope this makes it clearer, apologies my original Q wasn't clear enough!

Appreciate your help guys

 

[GTO]

I just ran Tom's code (XP/2000) and it does just as you describe in "will become:"

Are you sure you don't just need to stretch the cells out a bit, and rid borders/wrap/fill?

Mark

 

[Tom Urtis]

Yes, my code does what you want. Insert the line

Columns.Autofit

immediately after the line
Next Area

and before
.DisplayAlerts = True

 

[tommyleinen]

mmm... still comes out the same - only row 1 has data in it right up to column XFD, all other rows empty. I'm running Vista with excel 07, does that make a difference?

Just to confirm, here is the code I have from Tom:

Sub TranspozeRowz()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Dim asn$, xRow&, iCol%, cell As Range, area As Range
asn = ActiveSheet.Name
On Error Resume Next
Sheets("zzzTranspozed").Delete
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "zzzTranspozed"
xRow = 1
For Each area In Sheets(asn).Columns(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
Columns.AutoFit
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[Tom Urtis]

If that is what you are seeing then this you wrote could not be correct where I bolded the key words:
"I have one column of data (col. A) of customer names and addresses each with an empty row in between them."

If the cells in column A between the blocks of addresses really were empty ("empty" means nothing at all, not even a spacebar or some other character) then you will get the result you are seeing, because Excel would see one single contiguous current range instead of a bunch of separate ranges.

Take a close look at a cell in column A between addresses, and notice what is really in that cell. If for example such an empty-looking cell is A6, in some other cell enter the formula
=LEN(A6)
and see how many characters are in there.

Then, see what character the first character is with the formula
=CODE(LEFT(A6,1))

and maybe that code character will need to be replaced with nothing.

Something is going on with those cells you think are empty but really are not empty.

 

[ZVI]

Try this before applying of TranspozeRowz

Sub DelSpaces()
  Dim arr(), r As Long
  With ActiveSheet.UsedRange.Columns(1)
    arr() = .Value
    For r = 1 To UBound(arr)
      arr(r, 1) = Trim(Replace(arr(r, 1), Chr(160), ""))
    Next
    .Value = arr()
  End With
End Sub

 

[tommyleinen]

Okay - agreed something is not right here.

I've gone into a fresh tab in the same workbook and input some made up data (x3 so 2 spaces). The code worked like a charm.

I checked the 'empty' cells on the sheet with the real data using your formulas and they came back clear (0, and #value respectively)

To make absolutely sure, i deleted the first 3 empty rows and inserted a fresh row in their place, expecting the code to churn out 3 lines with the rest on one line, but, what do you know, it comes out the exact same as before.

The number of lines in my sheet is close to 130,000. Do you think this might be a factor?

The data was originally pasted (as text - not unicode text) from a text file. I have also replicated this with several made-up examples and your code works fine. With the customer details it doesn't.

I appreciate your effort on this there is nothing more frustrating - it should work!