excel transpose rows and duplicate first cell

**bencio82** · 11-08-2012, 06:21 AM

hi all,
referring to this topic as starting example http://www.excelforum.com/excel-gene...st-column.html
what i need to do is the exact opposite, so for example i've got this:
Col1 col2 col3 ...
Mississippi Jackson
Florida Orlando Tampa Jacksonville Pensacola Miami
Georgia Atlanta
Louisiana New Orleans Baton Rouge
Alabama Birmingham Mobile Montgomery

and i need this:

Mississippi Jackson
Florida Orlando
Florida Tampa
Florida Jacksonville
Florida Pensacola
Florida Miami
Georgia Atlanta
Louisiana New Orleans
Louisiana Baton Rouge
Alabama Birmingham
Alabama Mobile
Alabama Montgomery

any hint on how to do that?

**arlu1201** · 11-08-2012, 06:37 AM

Bastard82,

I have PM'd you regarding the username. Once you reply, we can proceed with providing you a solution.

**bencio82** · 11-08-2012, 06:56 AM

hi all, i've tried some modifications to the solution posted in the threadlinked previously and i came out with this solution.
it seems perfectly working; if you have alternative suggestions or how to make the code works better, feel free to post them.

thank you

Sub moveStuff()
Dim i As Long, j As Long, iCity As Long, strLast As String, outRow As Long  Dim strState As String
Dim outSht As Worksheet, inSht As Worksheet
i = 2
outRow = 2
Set inSht = ActiveSheet
Set outSht = Worksheets("Output")
outSht.Cells(1, 1) = "State"


Do Until inSht.Cells(i + 1, 1) = ""
    If inSht.Cells(i, 1) <> "" Then
        j = 2
        Do Until inSht.Cells(i, j) = ""
            outSht.Cells(outRow, 1) = inSht.Cells(i, 1)
            outSht.Cells(outRow, 2) = inSht.Cells(i, j)
            outRow = outRow + 1
            j = j + 1
        Loop

    i = i + 1
    End If
Loop
End Sub

**arlu1201** · 11-08-2012, 07:18 AM

I have sent forth your name change request to the tech team.

Why do you want to change the macro? Is it not working well for you? Is it slow?

**mike7952** · 11-08-2012, 07:22 AM

You need to remove the +1 from the do until

Do Until inSht.Cells(i + 1, 1) = ""

or heres another option

Sub abc()
 Const shRawData As String = "Sheet2" '<== Change as needed
 Const shOutput As String = "Output"  '<== Change as needed
 Dim a, b, i As Long, ii As Long, n As Long
 
 With Worksheets(shRawData)
    a = .Range("a1").CurrentRegion
 End With
 ReDim b(1 To Rows.Count, 1 To 2)
 For i = 2 To UBound(a, 1)
    For ii = 2 To UBound(a, 2)
        If IsEmpty(a(i, ii)) Then Exit For
        n = n + 1
        b(n, 1) = a(i, 1)
        b(n, 2) = a(i, ii)
    Next
 Next
 With Worksheets(shOutput)
    .Columns("a:b").Clear
    .Range("a1") = "State"
    .Range("a2").Resize(n, UBound(b, 2)) = b
 End With
End Sub