Repeating macro for each cell in A (with offset)

[anonymouslurker]

Hi everyone! Right now I'm having troubles with how to repeat my macro for each cell in A. I have some offsets so it becomes very confusing.

Here is my code. I recorded the macro while ticking 'Use Relative References' on.

Hopefully someone can help me. Thank you very much in advance

Sub MacroTest()
'
' MacroTest Macro
'
'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 8).Range("A1:A83").Select
Selection.Copy
ActiveWindow.ScrollRow = 1
ActiveCell.Offset(-1, -2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveCell.Offset(1, -6).Range("A1:F1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1:J83").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Can you please describe, in words, what you are trying to do?

 

[anonymouslurker]

Hi there! Basically I want to reformat my file with transpose.

People	Question	Answer
Person 1	Question 1	Answer 1
Person 1	Question 2	Answer 2
Person 2	Question 1	Answer 3
Person 2	Question 2	Answer 4
Person 3	Question 1	Answer 5
Person 3	Question 2	Answer 6

Here above is a very simple version of my table. In reality there are lots of questions (way more than 2), thousands of people (definitely much more than 3!), and other columns between People and Question. To make my file easier to view I want to reformat it into something like this:

People	Question 1	Question 2
Person 1	Answer 1	Answer 2
Person 2	Answer 3	Answer 4
Person 3	Answer 5	Answer 6

First I transposed the questions so the header looks like the second table above.

Then I recorded a macro. I selected cell A2 (where Person 1 is), then selected the whole row 2, then inserted a new row above it, like what I did below. Now the blank row is row 2.

People	Question 1	Question 2
Person 1	Question 1	Answer 1
Person 1	Question 2	Answer 2
Person 2	Question 1	Answer 3
Person 2	Question 2	Answer 4
Person 3	Question 1	Answer 5
Person 3	Question 2	Answer 6

Next, I copied the all Person 1's answers (Answer 1 and Answer 2), and pasted them specially (transpose) in the blank cell in Question 1. So now the blank cells in Question 1 and 2 have Answer 1 and 2, respectively.

Afterwards, I copied the 'Person 1' text (in underline) to the blank cell in People. Finally, I selected all records related to person 1 (in italic) and delete them shifting cells up. Now the first Person 2 record is in row 3.

What I want the code to do is for it to loop (selecting person 2 next) and then do the same steps as I describe above, going on and on and on until the last person. But I don't know how...

Hope this makes sense.

Help would be appreciated. Thank you

 

[Fluff]

Will the number of questions always be the same, or can that vary?
What columns are the Questions & and answers in?
Is the Name in col A starting in A2?

 

[anonymouslurker]

Number of questions will always be the same.
Question is in G, Answers is in I.
Yes, the name starts from A2. A1 is the header for the name.

Thanks

 

[Fluff]

Ok, thanks for that, forgot to ask how many questions, is it 83?

 

[anonymouslurker]

Yep, there are 83 questions.
Row 83 contains information of the 82nd question and Person 1's answer to it.
Row 85 contains information of the 1st question and Person 2's answer to it.

Thank you!

 

[Fluff]

Ok, this will put the output on another sheet, change sheet names in red to suit

Sub anonymouslurker()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long, nr As Long, j As Long
   
   Ary = Sheets("Master").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2) + 80)
   For i = 2 To UBound(Ary) Step 83
      nr = nr + 1
      For j = 1 To 6
         Nary(nr, j) = Ary(i, j)
      Next j
      For j = 1 To 83
         Nary(nr, j + 6) = Ary(i + j - 1, 9)
      Next j
   Next i
   Sheets("Sheet2").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

 

[anonymouslurker]

Hi there,
So I created a new Sheet in the same workbook named Sheet2.
Then I tried to run ThisWorkbook.anonymouslurker macro but it says 'Type mismatch'?

Thank you

 

[Fluff]

Do you have any blank rows or columns in your data?