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
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
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
 
Upvote 0
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:
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top