Creating a macro to transpose columns in to row to export a

[chrisscotty]

Hello All,

I have this list that is in notepad where all the items are vertical. I want to paste in excel so I can transpose the items . I will then export the items to a tab delimited file.

I know you can transpose one at at time by copy and special paste but when you have a few hundred, well, very time consuming.

I was hoping to create a macro. Each entry has one or two spaces before the next entry.

Thanks

They are all like this


Barbara Moon
PHONE: (905) 724-7756
FAX:
EMAIL: barbaro001@hotmail.com
ADDRESS:
APT. #:
CITY: Hamilton
PROVINCE: Ontario
POSTAL/ZIP: L4C 4S2
COUNTRY: CANADA
SALARY RANGE:
MOST RECENT JOB TITLE: Accounts/Finance, Office Manager
TOP 3 SKILLS: AccPac. Simply Accounting, Excel


Bill Kerry
PHONE: (416) 8432 4053
FAX:
EMAIL: bkerry99@sympatico.ca
ADDRESS: 102 Wilson Drive
APT. #:
CITY: Markham
PROVINCE: Ontario
POSTAL/ZIP: L3P 6C3
COUNTRY: CANADA
SALARY RANGE: $75000-99999
MOST RECENT JOB TITLE: Manager
TOP 3 SKILLS: 1) sales & relationship management, 2) team leadership/mentorship, 3) sales strategy development, tactics & process

 

[Tommy Bak]

Hi
this macro will transpose your column A and do nothing else.
Change iRecSize to fit your data.
As far as I can see each record is 13 rows + 1 empty =14
It's very fast and will place the transposed records starting in B1.

Still, I would go for Nate's solution as it is fully automatic....


Sub TransponerArray()
Dim lCounter As Long
Dim lLastRow As Long
Dim lTest As Long
Dim lCounter2 As Long
Dim vOldArray
Dim vNewArray

Const sInsertHere As String = "B1"
Const lFirstRow As Long = 1
Const lRecSize As Long=14 'Recordsize

lLastRow = Range("A65536").End(xlUp).Offset(1, 0).Row
vOldArray = Range("a" & lFirstRow & ":a" & lLastRow)
ReDim vNewArray(lLastRow lRecSize, lRecSize)
For lCounter = 1 To lLastRow Step lRecSize
lTest = lTest + 1
For lCounter2 = 1 To lRecSize
vNewArray(lTest, lCounter2) = vOldArray(lCounter + lCounter2 - 1, 1)
Next
Next
Range(sInsertHere).Resize(lTest, lRecSize - 1) = vNewArray

Set vOldArray = Nothing
Set vNewArray = Nothing
End Sub
This message was edited by Tommy Bak on 2002-11-16 17:24

 

[Whisperer14]

Corrected posting later on
This message was edited by Whisperer14 on 2002-11-17 17:21

 

[XL-Dennis]

Hi All,

Yes, I agree that Nate´s code is nice and running well

However, it seems, at least for me, that the OP don´t want a fully automatically procedure, just paste the values into XL and from inside XL transpose from column to rows.

Tommy´s solution (also a nice solution and I agree extremly fast ) should therefore suite the OP's need.

However I didn´t get it to work so I step through the code and adjusted it :

<PRE>
<FONT color=blue>Sub </FONT>TransposeArray()

<FONT color=blue>Dim </FONT>lCounter<FONT color=blue> As</FONT><FONT color=blue> Long</FONT>

<FONT color=blue>Dim </FONT>lLastRow<FONT color=blue> As</FONT><FONT color=blue> Long</FONT>

<FONT color=blue>Dim </FONT>lTest<FONT color=blue> As</FONT><FONT color=blue> Long</FONT>

<FONT color=blue>Dim </FONT>lCounter2<FONT color=blue> As</FONT><FONT color=blue> Long</FONT>

<FONT color=#ff0000>'explicit declaration so we know it´s variant-arrays we dealing with
</FONT>
<FONT color=blue>Dim </FONT>vOldArray<FONT color=blue> As</FONT><FONT color=blue> Variant</FONT>

<FONT color=blue>Dim </FONT>vNewArray<FONT color=blue> As</FONT><FONT color=blue> Variant</FONT>



<FONT color=blue>Const </FONT>sInsertHere<FONT color=blue> As</FONT><FONT color=blue> String</FONT> = "B1"

<FONT color=blue>Const </FONT>lFirstRow<FONT color=blue> As</FONT><FONT color=blue> Long</FONT> = 1

<FONT color=blue>Const </FONT>lRecSize<FONT color=blue> As</FONT><FONT color=blue> Long</FONT> = 14 <FONT color=#ff0000>'Recordsize
</FONT>


lLastRow = Range("A65536").End(xlUp).Offset(1, 0).Row

vOldArray = Range("a" & lFirstRow & ":a" & lLastRow)

<FONT color=#ff0000>'Revised
</FONT>
Re<FONT color=blue>Dim </FONT>vNewArray(lLastRow, lRecSize)



<FONT color=blue>For </FONT>lCounter = 1 <FONT color=blue>To </FONT>lLastRow Step lRecSize

lTest = lTest + 1

<FONT color=blue>For </FONT>lCounter2 = 1 <FONT color=blue>To </FONT>lRecSize

<FONT color=#ff0000>'Variant-arrays have always option base 0 which we have to consider in the following line.
</FONT>
vNewArray(lTest - 1, lCounter2 - 1) = vOldArray(lCounter - 1 + lCounter2, 1)

Next

Next



Range(sInsertHere).Resize(lTest, lRecSize - 1) = vNewArray



<FONT color=blue>Set </FONT>vOldArray =<FONT color=blue> Nothing</FONT>

<FONT color=blue>Set </FONT>vNewArray =<FONT color=blue> Nothing</FONT>

<FONT color=blue>End Sub</FONT>
</PRE>

Kind regards,
Dennis

 

[Tommy Bak]

Hi Dennis
I agree with the dim of Variant.
but the rest of the code is working perfectly here. Also the redim. (danish xl2000)

I use an OPTION BASE 1, sorry I didn't write that.

Dennis, could it be the OPTION BASE that does the job for me ??
regards Tommy
This message was edited by Tommy Bak on 2002-11-16 18:41
This message was edited by Tommy Bak on 2002-11-16 18:44

 

[XL-Dennis]

Hi Tommy,

I use an OPTION BASE 1, sorry I didn't write that.

Why didn´t I test it with base 1 - *LOL*
(too late in the night I guess :wink: )

Yes, it works beautiful on my maschine too -
Tommy, hat off for an extremly fast solution

I will expand it for a two-dimensional array and see the outcome of it.

Thanks!!
Dennis

 

[Whisperer14]

I see that the problem has been resolved nevertheless I will repost my answer which I believe also meets the desired criteria.

Best wishes Gordon

CODE

Public iRow As Long

Sub ClearBlanks()
'This sub will replace the variable number of blank rows with just one blank row which will then
'be used to transpose the columnal data to rows.
Dim i As Byte

For iRow = 13 To 65536 Step 14
i = 0
While Left(Cells(iRow, 1), 3) = "TOP" And Cells(iRow + 2, 1) = ""
i = i + 1
Rows(iRow + 1).Delete
If i = 10 Then
Transposing
Exit Sub
End If
Wend
Next iRow
Transposing
End Sub

Sub Transposing()
' Places the detail into the 14th row
Dim i As Long

For i = 14 To iRow + 1 Step 14
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.FormulaArray = "=TRANSPOSE(R[-13]C:R[-1]C)"
Selection.Copy
Cells(i, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
DeleteBlock
End Sub

Sub DeleteBlock()
Dim j As Byte
Dim i As Integer

i = 1
While Cells(i, 1) <> ""
For j = 1 To 13
Rows(i).Delete
Next j
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.Delete Shift:=xlToLeft
i = i + 1
Wend
End Sub

 

[chrisscotty]

Thank You all for your efforts.

For one reason or another none of the codes seem to be working. Because there are comments in some of the code I do not know how much to take out.

I tested with only 3 entries


Also the data was pasted using macro magic and there are several entries that have 3 salary ranges and other quirks ( they were done one by one)so I have to go through it again so all the fields are uniform.
(thought the ones I tested were uniform)

I find that I work extremely hard trying to find the easy way =-0



Comments for Nate:

I made a couple assumptions that may clear up why I was getting errors.

1) I would copy and paste the data from my notepad file in to excel and then run the macro.
2) I did manually create a stuff.txt and stuff2.txt in the c:temp directory (as was in code) and still got the error. I also put in a tempstuff.txt file in the directory since that was in the error file.
3) I still got the same error. Now I put in the foundfile.txt =-) with all my data that is to be transposed.

If we can make it work ...great !.

Thank you all for your efforts!.
This message was edited by chrisscotty on 2002-11-17 21:44

 

[NateO]

1) I would copy and paste the data from my notepad file in to excel and then run the macro.

Now '97 Tested, the following met your query:<pre>
Sub Stuff()
Dim cl As Range
Range("a1:" & [a1].End(xlDown).Address).Copy
[b1].PasteSpecial Transpose:=True
Application.CutCopyMode = False
For Each cl In [a:a].SpecialCells(xlCellTypeBlanks)
If cl(2)<> "" Then
Range(cl(2), cl(2).End(xlDown)).Copy
cl(2, 2).PasteSpecial Transpose:=True
Application.CutCopyMode = False
End If
Next
[a1].EntireColumn.Delete
[b:b].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub</pre>

2) I did manually create a stuff.txt and stuff2.txt in the c:temp directory (as was in code) and still got the error. I also put in a tempstuff.txt file in the directory since that was in the error file.

No need to create stuff2.txt, Excel will do this for you. Simply save the text file as Stuff.txt, or alter the procedure and you're golden.

If we can make it work ...great !.

Thank you all for your efforts!.

If this is the last g&d-d$mn thing I do on this plant, it'll work!

Hope this helps us progress.....

Edit: You did get error's with the other submitions? Having seen both posters in action before, I have assumed they both work [quite] well, note to add the option to your module as mentioned above.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-11-18 02:53

 

[chrisscotty]

Your The Man =-)

Not only was the macro smooth and short it also brewed my coffee and made me lunch !

Works great !.

The last post before yours worked but only with small amounts of entries and not each time. Could be because there were spaces .
This message was edited by chrisscotty on 2002-11-19 02:34

 

[varodrig]

Hello all, I have a similar question to the OP. My data looks as follows:

<table x:str="" style="border-collapse: collapse; width: 436pt;" border="0" cellpadding="0" cellspacing="0" width="581"><col style="width: 156pt;" width="208"> <col style="width: 149pt;" width="199"> <col style="width: 131pt;" width="174"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl22" style="height: 12.75pt; width: 156pt;" width="208" height="17">Object Type</td> <td class="xl22" style="width: 149pt;" width="199">Object Properties</td> <td class="xl22" style="width: 131pt;" width="174">Property Values</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">GSR_DIPD01</td> <td class="xl23">
</td> <td class="xl23">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::Inverted</td> <td class="xl23" x:bool="TRUE" x:fmla="= TRUE">TRUE</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ObjectName</td> <td class="xl23" x:fmla="= "942-HS____-1001_"">942-HS____-1001_</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::DisturbanceUsed</td> <td class="xl23" x:bool="FALSE" x:fmla="= FALSE">FALSE</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::CycleTime</td> <td class="xl23" x:fmla="= "3s"">3s</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelFont</td> <td class="xl23" x:fmla="= "FC30"">FC30</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::OffColor</td> <td class="xl23" x:fmla="= "L5"">L5</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOffColor</td> <td class="xl23" x:fmla="= "A1"">A1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelColor</td> <td class="xl23" x:fmla="= "A1"">A1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOff</td> <td class="xl23" x:fmla="= "ON"">ON</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ProcessDialog</td> <td class="xl23" x:fmla="= "dcDiButtonDialog"">dcDiButtonDialog</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOn</td> <td class="xl23" x:fmla="= "ON"">ON</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">GSR_DIPD01</td> <td class="xl23">
</td> <td class="xl23">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::Inverted</td> <td class="xl23" x:bool="TRUE" x:fmla="= TRUE">TRUE</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ObjectName</td> <td class="xl23" x:fmla="= "942-HS____-1002_"">942-HS____-1002_</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::DisturbanceUsed</td> <td class="xl23" x:bool="FALSE" x:fmla="= FALSE">FALSE</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::CycleTime</td> <td class="xl23" x:fmla="= "3s"">3s</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelFont</td> <td class="xl23" x:fmla="= "FC30"">FC30</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::OffColor</td> <td class="xl23" x:fmla="= "L5"">L5</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOffColor</td> <td class="xl23" x:fmla="= "A1"">A1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelColor</td> <td class="xl23" x:fmla="= "A1"">A1</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOff</td> <td class="xl23" x:fmla="= "ON"">ON</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ProcessDialog</td> <td class="xl23" x:fmla="= "dcDiButtonDialog"">dcDiButtonDialog</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::LabelOn</td> <td class="xl23" x:fmla="= "ON"">ON</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">AIEPD07</td> <td class="xl23">
</td> <td class="xl23">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ConditionCycle</td> <td class="xl23" x:fmla="= "onRequest+onEvent"">onRequest+onEvent</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ObjectName</td> <td class="xl23" x:fmla="= "942-PT____-1009_"">942-PT____-1009_</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::BackgroundColor</td> <td class="xl23" x:fmla="= "E10"">E10</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23" style="height: 12.75pt;" height="17">
</td> <td class="xl23">ports::ButtonText</td> <td class="xl23" x:str="" x:fmla="= """>BLUE
</td> </tr> </tbody></table>

The first column contains "object types" and the second and third column contain properties of those objects. The number of properties varies for each object. The properties begin one cell right and down from the object types. The next object is then one cell down and left of the last property of the previous object.

What I'm trying to do is transpose the properties data for each object type to the row containing the object type. The names of the properties (example ports::inverted) would be the column headers. The property values (example TRUE) would be the data. The rows that used to contain the properties should be deleted. This is the easy bit and I'm not sure how to do it

I think the difficult bit is what comes next. For the first object type, all the properties would become new column headers. For the second object type, the function would have to look to see what column headers (what properties) already exist and create new ones ONLY if required.

So my final result would look something like this (hopefully this works):

<table x:str="" style="border-collapse: collapse; width: 1575pt;" border="0" cellpadding="0" cellspacing="0" width="2095"><col style="width: 64pt;" width="85"> <col style="width: 75pt;" width="100"> <col style="width: 119pt;" width="158"> <col style="width: 101pt;" width="134"> <col style="width: 71pt;" width="94"> <col style="width: 92pt;" width="122"> <col style="width: 113pt;" width="151"> <col style="width: 83pt;" width="111"> <col style="width: 81pt;" width="108"> <col style="width: 76pt;" width="101"> <col style="width: 101pt;" width="134"> <col style="width: 86pt;" width="114"> <col style="width: 74pt;" width="98"> <col style="width: 105pt;" width="140"> <col style="width: 73pt;" width="97"> <col style="width: 87pt;" span="3" width="116"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl22" style="width: 75pt;" width="100">Object Type</td> <td class="xl22" style="width: 119pt;" width="158">Object Properties</td> <td class="xl22" style="width: 101pt;" width="134">Property Values</td> <td class="xl23" style="width: 71pt;" width="94">ports::Inverted</td> <td class="xl23" style="width: 92pt;" width="122">ports::ObjectName</td> <td class="xl23" style="width: 113pt;" width="151">ports::DisturbanceUsed</td> <td class="xl23" style="width: 83pt;" width="111">ports::CycleTime</td> <td class="xl23" style="width: 81pt;" width="108">ports::LabelFont</td> <td class="xl23" style="width: 76pt;" width="101">ports::OffColor</td> <td class="xl23" style="width: 101pt;" width="134">ports::LabelOffColor</td> <td class="xl23" style="width: 86pt;" width="114">ports::LabelColor</td> <td class="xl23" style="width: 74pt;" width="98">ports::LabelOff</td> <td class="xl23" style="width: 105pt;" width="140">ports::ProcessDialog</td> <td class="xl23" style="width: 73pt;" width="97">ports::LabelOn</td> <td class="xl23" style="width: 87pt;" width="116">ports::ConditionCycle</td> <td class="xl23" style="width: 87pt;" width="116">ports::BackgroundColor</td> <td class="xl23" style="width: 87pt;" width="116">ports::ButtonText</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23">GSR_DIPD01</td> <td class="xl23">
</td> <td class="xl23">
</td> <td class="xl23" x:bool="TRUE" x:fmla="= TRUE">TRUE</td> <td class="xl23" x:fmla="= "942-HS____-1001_"">942-HS____-1001_</td> <td class="xl23" x:bool="FALSE" x:fmla="= FALSE">FALSE</td> <td class="xl23" x:fmla="= "3s"">3s</td> <td class="xl23" x:fmla="= "FC30"">FC30</td> <td class="xl23" x:fmla="= "L5"">L5</td> <td class="xl23" x:fmla="= "A1"">A1</td> <td class="xl23" x:fmla="= "A1"">A1</td> <td class="xl23" x:fmla="= "ON"">ON</td> <td class="xl23" x:fmla="= "dcDiButtonDialog"">dcDiButtonDialog</td> <td class="xl23" x:fmla="= "ON"">ON</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23">GSR_DIPD01</td> <td class="xl23">
</td> <td class="xl23">
</td> <td class="xl23" x:bool="TRUE" x:fmla="= TRUE">TRUE</td> <td class="xl23" x:fmla="= "942-HS____-1002_"">942-HS____-1002_</td> <td class="xl23" x:bool="FALSE" x:fmla="= FALSE">FALSE</td> <td class="xl23" x:fmla="= "3s"">3s</td> <td class="xl23" x:fmla="= "FC30"">FC30</td> <td class="xl23" x:fmla="= "L5"">L5</td> <td class="xl23" x:fmla="= "A1"">A1</td> <td class="xl23" x:fmla="= "A1"">A1</td> <td class="xl23" x:fmla="= "ON"">ON</td> <td class="xl23" x:fmla="= "dcDiButtonDialog"">dcDiButtonDialog</td> <td class="xl23" x:fmla="= "ON"">ON</td> <td>
</td> <td>
</td> <td>
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl23">AIEPD07</td> <td class="xl23">
</td> <td class="xl23">
</td> <td>
</td> <td class="xl23" x:fmla="= "942-PT____-1009_"">942-PT____-1009_</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td>
</td> <td class="xl23" x:fmla="= "onRequest+onEvent"">onRequest+onEvent</td> <td class="xl23" x:fmla="= "E10"">E10</td> <td>BLUE</td> </tr> </tbody></table>

Note how only some of the properites of AIEPD07 had to be created fresh since they had not existed previously.

Hopefully somebody can help! Thank you!!!!