# Loop Required to Transpose Data from Columns to Rows

#### mbf1

##### New Member
Hi, I have been struggling to transpose 3 columns of data into rows for the last week. The data relates to a huge number of part numbers - some part numbers have only 5 different field names while others have up to 39 different fields names. Column 1 contains the part number (repeated until next part), colum 2 contains the field name, column 3 contains the field value.

The end result i need is row 1 containing the 39 different field names and Column 1 containing all the part numbers, with the field values inserted accordingly, maybe using a vlookup.

Would very much appreciate your feedback

### Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a \$25,000 loan, 5% annual interest, 60 month loan.

#### hsk

##### Well-known Member
What i understand is u want a table,
Code:
``````	    Field-1    Field-2   Field-3
Part-1	(cellA1)	 (B1)	(C1)
Part-2	(A2)	     (B2)	(C2)
Part-3	(A3)	     (B3)	(C3)``````
And what u have is

Code:
``````ColA         B        C
Part-1	Field-1	Value
Part-1	Field-2	Value
Part-2	Field-1	Value
Part-2	Field-2	Value
Part-2	Field-3	Value``````
The idea is replace part number and Fields with number (Part-1 with 1, Part-2 with 2 and Fields-1 with 1, Fields-2 with 2 ...so on
so ur data will look like

Code:
``````A	B	C
1	1	Value
1	2	Value
2	1	Value
2	2	Value
2	3	Value``````

now if u can see - A is Row index and B is Column Index and C gives the value u want to put.
Code a simple macro to put values from column C in cell(a,b)

Code:
``````For i = 1 to limit                              <- limit = total # of values in column C
a = range("A" & i).value             <- get row index
b = range("B" & i).value             <- get column index
c = range("C" & i).value             <- get value
cell(a,b).value = c                     <- put value in cell(a,b)]
Next``````

#### Krishnakumar

##### Well-known Member
Hi,

Code:
``````Sub test()
Dim Part        As Range
Dim FieldList   As Range
Dim FieldNames  As Range
Dim FieldName   As Range

Application.ScreenUpdating = False
), Unique:=True
), Unique:=True
Range("F2", [f65536].End(xlUp)).Copy
Range("F1").PasteSpecial , , , True
Range("F2", [f65536].End(xlUp)).ClearContents
Set FieldList = Range("F1", [iv1].End(xlToLeft))
For Each Part In Range("E2", [e65536].End(xlUp))
With Range("A1:C" & [a65536].End(xlUp).Row)
.AutoFilter field:=1, Criteria1:=Part
Set FieldNames = .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
For Each FieldName In FieldNames
x = Application.WorksheetFunction.Match(FieldName, FieldList, 0)
Part.Offset(, x) = FieldName.Offset(, 1).Value
Next FieldName
.AutoFilter
End With
Next Part
Application.ScreenUpdating = True
End Sub``````

HTH

#### agihcam

##### Well-known Member
Hi -
have your tried using pivot table?

#### al_b_cnu

##### Well-known Member

Hi,

I see that Kris has beaten me to it, but here's my solution for what it's worth :¬/

Code:
``````Sub TransposePartNums()
Dim R As Range
Dim dCurValue As Double
Dim sCurPart As String, sCurName As String
Dim vRowPartNum As Variant, vColName As Variant
Dim wsFr As Worksheet, wsTo As Worksheet

'-- Set 'From' & 'To' sheets --
Set wsFr = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

'-- Clear 'To' sheet data --
wsTo.UsedRange.ClearContents

For Each R In wsFr.Range("A2:A" & wsFr.Cells(Rows.Count, "A").End(xlUp).Row)
sCurPart = R.Text
sCurName = R.Offset(0, 1).Text
dCurValue = Val(R.Offset(0, 2).Value)
vRowPartNum = "*"
On Error Resume Next
vRowPartNum = WorksheetFunction.Match(sCurPart, wsTo.Columns("A"), 0)
On Error GoTo 0
If IsNumeric(vRowPartNum) = False Then
vRowPartNum = wsTo.Cells(Rows.Count, "A").End(xlUp).Row + 1
wsTo.Cells(vRowPartNum, "A").Value = sCurPart
End If
On Error Resume Next
vColName = "*"
vColName = WorksheetFunction.Match(sCurName, wsTo.Rows(1), 0)
On Error GoTo 0
If IsNumeric(vColName) = False Then
vColName = wsTo.Cells(1, Columns.Count).End(xlToLeft).Column + 1
wsTo.Cells(1, vColName).Value = sCurName
End If
wsTo.Cells(vRowPartNum, vColName).Value = dCurValue
Next R

End Sub``````

This copies & transposes the data from Sheet1 to Sheet2

#### al_b_cnu

##### Well-known Member
... so if sheet1 looks like:
Book1.xls
ABCD
1Part Numfield NameValue
2AAA0NAME 178
3AAA0NAME 337
4AAA0NAME 492
5AAA0NAME 780
6AAA1NAME 027
7AAA1NAME 482
8AAA1NAME 421
9AAA1NAME 626
10AAA1NAME 828
11AAA2NAME 137
12AAA2NAME 350
13AAA2NAME 422
14AAA2NAME 535
15AAA2NAME 527
16AAA2NAME 786
17AAA2NAME 977
18AAA3NAME 067
19AAA3NAME 129
20AAA3NAME 238
21AAA3NAME 321
22AAA3NAME 683
23AAA3NAME 771
24AAA3NAME 980
25AAA4NAME 146
Sheet1

Sheet2 will look like:
Book1.xls
ABCDEFGHIJK
1NAME 1NAME 3NAME 4NAME 7NAME 0NAME 6NAME 8NAME 5NAME 9NAME 2
2AAA078379280
3AAA121272628
4AAA2375022862777
5AAA329217167838038
6AAA446269514732
7AAA542670
8AAA678125298978726
9AAA7471833171899350
10AAA834433453737
11AAA91450890585836
Sheet2

#### mbf1

##### New Member
Thanks it worked !

Thanks to everyone who contributed my post - I am overwhelmed by your responses ! Firstly I tried Krishnakumar's code which errored out part way thru. I then tried al_b_cnu's code and it worked beautifully !

I am now studying all the code submitted and try to work thru how you've put these bit of code together. BTW I purchased the Mr Excel book of VBA and Macros for Excel to try to solve this problem, but now feel the problem's a bit too advanced for my first forays into VBA.

Thanks again everyone !

#### Krishnakumar

##### Well-known Member
Hi,

If the Sheet1 looks like Alan's Sheet1 then mine works fine for me.

Replies
0
Views
58
Replies
2
Views
142
Replies
1
Views
272
Replies
4
Views
513
Replies
9
Views
82

1,141,722
Messages
5,708,098
Members
421,546
Latest member
delatollas

### 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.

### Which adblocker are you using?

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

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