transposition macro help

[databasewolfy]

Hey there. I'm new to macros and programming. I am trying to make this data

device1

app1

app2

app3

app4

app5

app6

app7

app8

device2

app1

app2

app3

app4

device3

app1

app2

app3

app4

app5

app6

app7

app8

app9

app10

app11

app12

app13

app14

<colgroup><col style="width:48pt" width="64" span="15"> </colgroup><tbody>
</tbody>

output like this:

device1	app1
device1	app2
device1	app3
device1	app4
device1	app5
device1	app6
device1	app7
device1	app8
device2	app1
device2	app2
device2	app3
device2	app4
device3	app1
device3	app2
device3	app3
device3	app4
device3	app5
device3	app6
device3	app7
device3	app8
device3	app9
device3	app10
device3	app11
device3	app12
device3	app13
device3	app14

<colgroup><col style="width:48pt" width="64" span="2"> </colgroup><tbody>
</tbody>

 

[Fluff]

Hi & welcome to MrExcel.
Do you have a header row on the original data?

 

[Fluff]

Also forgot to ask, where do you want the output?

 

[databasewolfy]

There is header info but I will be omitting it so it won't matter. As far as output, a new sheet would work. Thanks!

 

[Fluff]

Ok, how about

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.

 

[databasewolfy]

You are a god. Cheers!

Ok, how about

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.

 

[Fluff]

You're welcome & thanks for the feedback

 

[databasewolfy]

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.