Macro for rearranging a range (Transpose and possibly loops)

[willip19]

Hi everyone, I've tried finding an answer to this on my own, but to no avail.

To sum up my problem, I'm trying to write a macro that could take the input data from Sheet2 (see below) and rearrange it so that it can be used for data import in Sheet1.
Name IDs would need to be repeated consecutively for the amount of skills present in the data in column 1, and in column 2, the skillsIDs would need to be transposed and pasted multiple times (#of names). The matching scores should then be added in column 3 as well. Please note that amount of data is variable, so it would be needed to have a way to make it dynamic.


The input is formatted like this (blank cells in the top left corner will always be that way):
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD]Skill 1[/TD]
[TD]Skill 2[/TD]
[TD]Skill 3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]s1[/TD]
[TD]s2[/TD]
[TD]s3[/TD]
[/TR]
[TR]
[TD]Name 1[/TD]
[TD]n1[/TD]
[TD]score1[/TD]
[TD]score2[/TD]
[TD]score3[/TD]
[/TR]
[TR]
[TD]Name 2[/TD]
[TD]n2[/TD]
[TD]score4[/TD]
[TD]score5[/TD]
[TD]score6[/TD]
[/TR]
[TR]
[TD]Name 3[/TD]
[TD]n3[/TD]
[TD]score7[/TD]
[TD]score8[/TD]
[TD]score9[/TD]
[/TR]
</tbody>[/TABLE]


This is how I would need the data to look like after the transformation (no need for names and skill names, only IDs):

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]n1[/TD]
[TD]s1[/TD]
[TD]score1[/TD]
[/TR]
[TR]
[TD]n1[/TD]
[TD]s2[/TD]
[TD]score2[/TD]
[/TR]
[TR]
[TD]n1[/TD]
[TD]s3[/TD]
[TD]score3[/TD]
[/TR]
[TR]
[TD]n2[/TD]
[TD]s1[/TD]
[TD]score4[/TD]
[/TR]
[TR]
[TD]n2[/TD]
[TD]s2[/TD]
[TD]score5[/TD]
[/TR]
[TR]
[TD]n2[/TD]
[TD]s3[/TD]
[TD]score6[/TD]
[/TR]
[TR]
[TD]n3[/TD]
[TD]s1[/TD]
[TD]score7[/TD]
[/TR]
[TR]
[TD]n3[/TD]
[TD]s2[/TD]
[TD]score8[/TD]
[/TR]
[TR]
[TD]n3[/TD]
[TD]s3[/TD]
[TD]score9[/TD]
[/TR]
</tbody>[/TABLE]


Let me know if you need more information on the problem!

Thanks in advance

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub willip19()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Sheets("Sheet1").Range("A3").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 3)
   For r = 3 To UBound(Ary)
      For c = 3 To UBound(Ary, 2)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(2, c)
         Nary(nr, 3) = Ary(r, c)
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 3).Value = Nary
End Sub

 

[willip19]

Works like a charm!

Massive thanks for your help

 

[DanteAmor]

Another way with a single for

Sub trs()
  Dim sh As Worksheet, r As Range, Ary As Variant, i As Long, c As Range
  Set sh = Sheets("Sheet1")
  Set r = sh.Range("C3", sh.Cells(sh.Range("C" & Rows.Count).End(xlUp).Row, sh.Cells(3, Columns.Count).End(xlToLeft).Column))
  ReDim Ary(1 To (r.Rows.Count) * (r.Columns.Count), 1 To 3)
  i = 1
  For Each c In r
    Ary(i, 1) = sh.Cells(c.Row, "B")
    Ary(i, 2) = sh.Cells(2, c.Column)
    Ary(i, 3) = c
    i = i + 1
  Next
  Sheets("Sheet2").Range("A2").Resize(i - 1, 3).Value = Ary
End Sub

 

[Fluff]

Works like a charm!

Massive thanks for your help

My pleasure & thanks for the feedback