transposition macro help

databasewolfy

New Member
Joined
Aug 12, 2019
Messages
6
Hey there. I'm new to macros and programming. I am trying to make this data

device2app1app2app3app4
device3app1app2app3app4app5app6app7app8app9app10
app11app12app13app14

<colgroup><col style="width:48pt" width="64" span="15"> </colgroup><tbody>
[TD="width: 64"]device1[/TD]
[TD="width: 64"]app1[/TD]
[TD="width: 64"]app2[/TD]
[TD="width: 64"]app3[/TD]
[TD="width: 64"]app4[/TD]
[TD="width: 64"]app5[/TD]
[TD="width: 64"]app6[/TD]
[TD="width: 64"]app7[/TD]
[TD="width: 64"]app8[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]

</tbody>



output like this:

device1app2
device1app3
device1app4
device1app5
device1app6
device1app7
device1app8
device2app1
device2app2
device2app3
device2app4
device3app1
device3app2
device3app3
device3app4
device3app5
device3app6
device3app7
device3app8
device3app9
device3app10
device3app11
device3app12
device3app13
device3app14

<colgroup><col style="width:48pt" width="64" span="2"> </colgroup><tbody>
[TD="width: 64"]device1[/TD]
[TD="width: 64"]app1[/TD]

</tbody>
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi & welcome to MrExcel.
Do you have a header row on the original data?
 
Upvote 0
Also forgot to ask, where do you want the output?
 
Upvote 0
Ok, how about
Code:
Sub databasewolfy()
   Dim ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(ary) * UBound(ary, 2), 1 To 2)
   For r = 1 To UBound(ary)
      For c = 2 To UBound(ary, 2)
         If ary(r, c) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = ary(r, 1): Nary(nr, 2) = ary(r, c)
         End If
      Next c
   Next r
   Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A1").Resize(nr, 2).Value = Nary
End Sub
change sheet name in red to suit for the output sheet.
 
Upvote 0
You are a god. Cheers!

Ok, how about
Code:
Sub databasewolfy()
   Dim ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(ary) * UBound(ary, 2), 1 To 2)
   For r = 1 To UBound(ary)
      For c = 2 To UBound(ary, 2)
         If ary(r, c) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = ary(r, 1): Nary(nr, 2) = ary(r, c)
         End If
      Next c
   Next r
   Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A1").Resize(nr, 2).Value = Nary
End Sub
change sheet name in red to suit for the output sheet.
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
Mr Fluff, sir,

So when I did this, i did not realize the data I'd pulled by trying to manipulate a column full of 500 separate line breaked entries into CSV to try and separate them... was done incorrectly. So the macro worked as expected... the data it was processing was just FUBAR from the start.

https://www.mrexcel.com/forum/excel...ro-help-text-extraction-cell-line-breaks.html

I should've probably just asked the above question first.
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top