VBA to transpose table and split column into two

[megatracer]

Hello all,

I am struggling to transpose the table, plus I would need to split the newly rotated column into two.

Here is an example:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Workweek[/TD]
[TD]Intern - male[/TD]
[TD]Intern - female[/TD]
[TD]Intern - other[/TD]
[/TR]
[TR]
[TD]WW39[/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]WW40[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]


Here is the transposed table:


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]type/gender[/TD]
[TD]WW39[/TD]
[TD]WW40[/TD]
[/TR]
[TR]
[TD]Intern - male[/TD]
[TD]2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Intern - female[/TD]
[TD]1[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Intern - other[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]


And the final step - dividing first column into two. THe splitter is " - "


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]type[/TD]
[TD]gender[/TD]
[TD]WW39[/TD]
[TD]WW40[/TD]
[/TR]
[TR]
[TD]Intern[/TD]
[TD]male[/TD]
[TD]2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Intern[/TD]
[TD]female[/TD]
[TD]1[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Intern[/TD]
[TD]other[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]

Table should be copied from one permanent tab, let´s call it "Source" into the tab called "Converted data".

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG28Sep50
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Copy
[COLOR="Navy"]With[/COLOR] Sheets("Coverted Data")
    .Range("A1").PasteSpecial Transpose:=True
    .Columns(2).Insert
    .Range("A1:B1").Value = Array("Type", "Gender")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, "-")
    Dn = Sp(0): Dn.Offset(, 1) = Sp(1)
[COLOR="Navy"]Next[/COLOR] Dn
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[megatracer]

Hello Mick,

I am getting a runtime error 1004: Application defined or object defined error

I commented everything else besides .Range("A1").PasteSpecial Transpose:=True
and the error is there

 

[MickG]

I think the error is mine , because I have called your sheet "Coverted Data" instead on Converted Data"
alter line below:-

[COLOR=#000080]With[/COLOR] Sheets("Converted Data")

 

[megatracer]

Hi Mick,

this one I saw and corrected before.. but still the error was there.

in the meantime I was able to adapt one of the existing scripts to rotate the table using slightly different technique.
Differently to what I showed before as resulting table, I am turning work weeks into an attribute (column) of headcount, similar to gender and type.

    Application.ScreenUpdating = False    rw = 2
    Set sh_input = Sheets("Source")
    a = sh_input.UsedRange.Value
    Set sh = Sheets("Converted Data")
    sh.Cells.Clear
    With sh
        .Cells(1, 1).Resize(1, 4) = Array("Type", "Gender", "WW", "HC")
        For i = 2 To UBound(a)
            For j = 2 To 4
                If a(i, j) <> "" Then
                    
                         Sp = Split(a(1, j), " - ")
                        .Cells(rw, 1) = Sp
                        .Cells(rw, 2) = Sp(1)
                        .Cells(rw, 3) = a(i, 1)
                        .Cells(rw, 4) = a(i, j)
                     rw = rw + 1
                End If
            Next
        Next
        For i = 1 To 4
            .UsedRange.Borders(i).LineStyle = xlContinuous
        Next
    End With
    
    Application.ScreenUpdating = True

Thanks anyway for your quick help!!