Transpose Code Needed Please For Work.

[Dazzawm]

I have sheet 1 as laid out below. I need a code please that will transpose onto sheet 2 and give the example results on sheet 2.

Sheet 1 Before Code

Excel 2010
	A	B	C	D	E
1	STCODE	ALT5_CODE	ALT10_CODE	ALT11_CODE	ALT12_CODE
2	EXDN6031	22624	NIS6032,38634	P4261,NS53105,01.92170	51.24.07,32.7004,44.002.83
3	EXCN2013	01236,01019	CIT2014
4	EXCN6039	01011,01145,01033	CIT6040
5	EXCN3035	01010	CIT3036
Sheet1

Sheet 2 After Code

Excel 2010
	A	B	C
1	Comparative Name	Comparative Part No.	Your Part No.
2	ALT10_CODE	38634	EXDN6031
3	ALT10_CODE	NIS6032	EXDN6031
4	ALT10_CODE	CIT2014	EXCN2013
5	ALT10_CODE	CIT3036	EXCN3035
6	ALT10_CODE	CIT6040	EXCN6039
7	ALT11_CODE	1.92170	EXDN6031
8	ALT11_CODE	NS53105	EXDN6031
9	ALT11_CODE	P4261	EXDN6031
10	ALT12_CODE	32.7004	EXDN6031
11	ALT12_CODE	44.002.83	EXDN6031
12	ALT12_CODE	51.24.07	EXDN6031
13	ALT5_CODE	01010	EXCN3035
14	ALT5_CODE	01011	EXCN6039
15	ALT5_CODE	01019	EXCN2013
16	ALT5_CODE	01033	EXCN6039
17	ALT5_CODE	01145	EXCN6039
18	ALT5_CODE	01236	EXCN2013
19	ALT5_CODE	22624	EXDN6031
Sheet2

As you can see the code has put 3 headings on sheet 2. When a number is separated by a comma a row is added for each number where I have highlighted in yellow as an example. A little tricky to explain but please contact me for clarification of anything.

On sheet 1 there may be more columns with the same sort of data up to a possible 20 columns.

 

[wideboydixon]

Give this a shot:

Public Sub TransposeData()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim thisCol As Long
Dim nextRow As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim allValues As Variant
Dim thisValue As Variant

' Set up the worksheets
Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))

' Find the last row as column on the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
lastCol = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column

' Set the headers on the target sheet
targetSheet.Cells(1, 1).Value = "Comparative Name"
targetSheet.Cells(1, 2).Value = "Comparative Part No."
targetSheet.Cells(1, 3).Value = "Your Part No."

' The next row on the target sheet
nextRow = 2

' Process all columns
For thisCol = 2 To lastCol
    ' Process all rows
    For thisRow = 2 To lastCol
        ' Split up the values in the current cell
        allValues = Split(sourceSheet.Cells(thisRow, thisCol).Value, ",")
        
        ' Process all values
        For thisValue = 0 To UBound(allValues)
            ' Make sure it's not a blank value
            If allValues(thisValue) <> "" Then
                ' Populate the data in this row
                targetSheet.Cells(nextRow, 1).Value = sourceSheet.Cells(1, thisCol).Value
                targetSheet.Cells(nextRow, 2).Value = allValues(thisValue)
                targetSheet.Cells(nextRow, 3).Value = sourceSheet.Cells(thisRow, 1).Value
                
                ' Move to the next row
                nextRow = nextRow + 1
            End If
        Next thisValue
    Next thisRow
Next thisCol

End Sub

WBD

 

[Dazzawm]

Thanks WBD, it seems to work, almost! If you look at the results below it is missing the leading and ending zero on some numbers which I have highlighted. Thanks

Excel 2010
	A	B	C
1	Comparative Name	Comparative Part No.	Your Part No.
2	ALT5_CODE	22624	EXDN6031
3	ALT5_CODE	1236	EXCN2013
4	ALT5_CODE	1019	EXCN2013
5	ALT5_CODE	1011	EXCN6039
6	ALT5_CODE	1145	EXCN6039
7	ALT5_CODE	1033	EXCN6039
8	ALT5_CODE	1010	EXCN3035
9	ALT10_CODE	NIS6032	EXDN6031
10	ALT10_CODE	38634	EXDN6031
11	ALT10_CODE	CIT2014	EXCN2013
12	ALT10_CODE	CIT6040	EXCN6039
13	ALT10_CODE	CIT3036	EXCN3035
14	ALT11_CODE	P4261	EXDN6031
15	ALT11_CODE	NS53105	EXDN6031
16	ALT11_CODE	1.9217	EXDN6031
17	ALT12_CODE	51.24.07	EXDN6031
18	ALT12_CODE	32.7004	EXDN6031
19	ALT12_CODE	44.002.83	EXDN6031
Sheet4

 

[Dazzawm]

I have also noticed that when I try it on a larger dataset it only transposes the data I posted here as an example?

 

[wideboydixon]

First issue is down to the number format of the cell. Second issue is an oopsie :-O

Public Sub TransposeData()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim thisCol As Long
Dim nextRow As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim allValues As Variant
Dim thisValue As Variant

' Set up the worksheets
Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))

' Find the last row as column on the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
lastCol = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column

' Set the headers on the target sheet
targetSheet.Cells(1, 1).Value = "Comparative Name"
targetSheet.Cells(1, 2).Value = "Comparative Part No."
targetSheet.Cells(1, 3).Value = "Your Part No."

' The next row on the target sheet
nextRow = 2

' Process all columns
For thisCol = 2 To lastCol
    ' Process all rows
    For thisRow = 2 To lastRow
        ' Split up the values in the current cell
        allValues = Split(sourceSheet.Cells(thisRow, thisCol).Value, ",")
        
        ' Process all values
        For thisValue = 0 To UBound(allValues)
            ' Make sure it's not a blank value
            If allValues(thisValue) <> "" Then
                ' Populate the data in this row
                targetSheet.Cells(nextRow, 1).Value = sourceSheet.Cells(1, thisCol).Value
                targetSheet.Cells(nextRow, 2).NumberFormat = "@"
                targetSheet.Cells(nextRow, 2).Value = allValues(thisValue)
                targetSheet.Cells(nextRow, 3).Value = sourceSheet.Cells(thisRow, 1).Value
                
                ' Move to the next row
                nextRow = nextRow + 1
            End If
        Next thisValue
    Next thisRow
Next thisCol

End Sub

WBD

 

[Dazzawm]

Thanks a lot WBD, works great and thanks for your time.