VBA Help Required Please

[SV18]

Hi All,

Can someone help me with the following please?

I need to take the headers and the data from the criteria columns and and transpose them to sheet2, I need to do this for each individual ref number in column A.


The data currently looks like this:

Ref</SPAN>	Criteria 1</SPAN>	Criteria 2</SPAN>	Criteria 3</SPAN>	Criteria 4</SPAN>	Criteria 5</SPAN>	Criteria 6</SPAN>
F20180</SPAN>	Sam</SPAN>	N/A</SPAN>	N/A</SPAN>	Sam</SPAN>	28/05/1988</SPAN>	Live</SPAN>
F20181</SPAN>	Sam</SPAN>	N/A</SPAN>	N/A</SPAN>	Sam</SPAN>	28/05/1988</SPAN>	Live</SPAN>
F20184</SPAN>	Sam</SPAN>	N/A</SPAN>	N/A</SPAN>	Sam</SPAN>	28/05/1988</SPAN>	Live</SPAN>
F20204</SPAN>	Sam</SPAN>	N/A</SPAN>	N/A</SPAN>	Sam</SPAN>	06/04/1988</SPAN>	Live</SPAN>

<TBODY>
</TBODY>

I need it to look like this:

Ref</SPAN>	Service</SPAN>	Data</SPAN>
F20180</SPAN>	Criteria 1</SPAN>	Sam</SPAN>
F20180</SPAN>	Criteria 2</SPAN>	N/A</SPAN>
F20180</SPAN>	Criteria 3</SPAN>	N/A</SPAN>
F20180</SPAN>	Criteria 4</SPAN>	Sam</SPAN>
F20180</SPAN>	Criteria 5</SPAN>	32291</SPAN>
F20180</SPAN>	Criteria 6</SPAN>	Live</SPAN>

<TBODY>
</TBODY>

 

[hurgadion]

Hi,
let Your Data be in Columns A:G, then try to use the macro of the form:

Sub Makro()
Dim i&, j&, x&

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  For j = 1 To 6
    x = x + 1
    Cells(x, 8).Value = Cells(i, 1).Value
    Cells(x, 9).Value = "Criteria" & j
    Cells(x, 10).Value = Cells(i, j + 1).Value
  Next j
Next i
End Sub

Best regards.

 

[SV18]

Thanks for the reply...unfortunately the dataset I added to the above is only a tiny example of the range I really need to query, so I'm not too sure if this code is going to work on a larger dataset.

 

[hurgadion]

Maybe use arrays to find better Solution. I think, that this is possible, best regards.

 

[SV18]

The actual range is from B to IB, and the reference number in column A goes down to A633.

Do you think you can help now you know the ranges?

 

[hurgadion]

I think, that in Your case the Solution without arrays is good enough, try the macro:

Sub Makro()
Dim i&, j&, x&

With Worksheets("Sheet2")
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To 236
      x = x + 1
      .Cells(x, 1).Value = Cells(i, 1).Value
      .Cells(x, 2).Value = "Criteria" & j
      .Cells(x, 3).Value = Cells(i, j + 1).Value
    Next j
  Next i
End With

End Sub

Best regards.

 

[SV18]

Thanks once again but unfortunately this isn't working. I feel like all I need is some code that takes B2:IB2, transposes it as values into sheet2. Then takes the relevent line of data, transposes that as values into column C of sheet2 and replicates this for each reference number.

 

[hurgadion]

I tested the above macro in my WorkSheet and it is working. You have to activate it in Sheet1... It may be Your problem... Best regards.