Macro for rearranging a range (Transpose and possibly loops)

willip19

New Member
Joined
Oct 4, 2019
Messages
2
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):
Skill 1Skill 2Skill 3
s1s2s3
Name 1n1score1score2score3
Name 2n2score4score5score6
Name 3n3score7score8score9

<tbody>
</tbody>


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

n1s1score1
n1s2score2
n1s3score3
n2s1score4
n2s2score5
n2s3score6
n3s1score7
n3s2score8
n3s3score9

<tbody>
</tbody>


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

Thanks in advance
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,864
Office Version
365
Platform
Windows
Hi & welcome to MrExcel.
How about
Code:
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,221
Office Version
2007
Platform
Windows
Another way with a single for

Code:
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
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,089,948
Messages
5,411,466
Members
403,374
Latest member
PMMHart

This Week's Hot Topics

Top