Convert row with columns of data into column with multiple rows in Excel

Question

I hv rows of data:-

TAG   SKU   SIZE   GRADE   LOCATION
A001  123    12      A       X1
A002  789    13      B       X3
A003  456    15      C       X5

I need to convert it into:-

A001   123  SIZE 12
A001   123  GRADE A
A001   123  LOCATION X1
A002   789  SIZE 13
A002   789  GRADE B
A002   789  LOCATION X3
A003   456  SIZE 15
A003   456  GRADE C
A003   456  LOCATION X5

I used the below (based on Ben McCormack's suggestion posted on Nov 23 '09) but it doesn't produce the above result :-

Sub NormalizeSheet()
Dim wsOriginal As Worksheet
Dim wsNormalized As Worksheet
Dim strKey As String
Dim clnHeader As Collection
Dim lngColumnCounter As Long
Dim lngRowCounterOriginal As Long
Dim lngRowCounterNormalized As Long
Dim rngCurrent As Range
Dim varColumn As Variant

Set wsOriginal = ThisWorkbook.Worksheets("Original")     'This is the name of your original worksheet'
Set wsNormalized = ThisWorkbook.Worksheets("Normalized") 'This is the name of the new worksheet'
Set clnHeader = New Collection

wsNormalized.Cells.ClearContents        'This deletes the contents of the destination worksheet'

lngColumnCounter = 2
lngRowCounterOriginal = 1
Set rngCurrent = wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter)

' We'll loop through just the headers to get a collection of header names'
Do Until IsEmpty(rngCurrent.Value)
    clnHeader.Add rngCurrent.Value, CStr(lngColumnCounter)
    lngColumnCounter = lngColumnCounter + 1
    Set rngCurrent = wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter)
Loop

'Here we'll reset our Row Counter and loop through the entire data set'
lngRowCounterOriginal = 2
lngRowCounterNormalized = 1
lngColumnCounter = 1

Do While Not IsEmpty(wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter))

    Set rngCurrent = wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter)
    strKey = rngCurrent.Value ' Get the key value from the current cell'
    lngColumnCounter = 2

    'This next loop parses the denormalized values for each row'
    Do While Not IsEmpty(wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter))
        Set rngCurrent = wsOriginal.Cells(lngRowCounterOriginal, lngColumnCounter)

        'We're going to check to see if the current value'
        'is equal to NULL. If it is, we won't add it to'
        'the Normalized Table.'
        If rngCurrent.Value = "NULL" Then
            'Skip it'
        Else
            'Add this item to the normalized sheet'
            wsNormalized.Range("A" & lngRowCounterNormalized).Value = strKey
            wsNormalized.Range("B" & lngRowCounterNormalized).Value = clnHeader(CStr(lngColumnCounter))
            wsNormalized.Range("C" & lngRowCounterNormalized).Value = rngCurrent.Value
            lngRowCounterNormalized = lngRowCounterNormalized + 1
        End If

        lngColumnCounter = lngColumnCounter + 1
    Loop
    lngRowCounterOriginal = lngRowCounterOriginal + 1
    lngColumnCounter = 1    'We reset the column counter here because we're on a new row'
Loop



End Sub

You can convert the Excel file to a CSV and do the logic in your favorite language — yassin
– yassin, Commented Sep 13, 2010 at 11:15
Bob, you've got a bunch of people helping you build various parts of your project and you haven't accepted or voted up a single answer. How about giving us a little credit? — Marc Thibault
– Marc Thibault, Commented Sep 21, 2010 at 4:13
"vote up requires 15 reputation"... guess i'm still pretty new. — Bob
– Bob, Commented Sep 22, 2010 at 0:58

12 revs · Accepted Answer · 2010-09-23 01:18:29Z

1

Here's an approach going from worksheet to worksheet directly. This might be necessary if the dataset is too big and available memory too small for using arrays. It's likely to be slow.

It uses the same call parameters as reOrgV1, and pretty much the same logic.

It's updated to add "DEFECTS" to the properies. The input looks like:

TAG     SKU   SIZE GRADE LOCATION DEFECTS
A001    123    12   A       X1      3
A002    789    13   B       X3      5
A003    456    15   C       X5      7

Here's the code.

Public Sub reOrgV2(inSource As Range, inTarget As Range)
'' This version works directly on the worksheet
'' and transfers the result directly to the target
'' given as the top-left cell of the result.

'' **** Changed to add "Defects"
    Dim resNames()
    Dim propNum As Integer
    Dim srcRows As Integer
    Dim resRows As Integer
    Dim i As Integer
    Dim j As Integer
    Dim g As Integer

    '' Shape the result
    resNames = Array("Size", "Grade", "Location", "Defects")
    propNum = 1 + UBound(resNames)

    '' Row counts
    srcRows = inSource.Rows.Count
    resRows = srcRows * propNum

    '' re-org and transfer source to result range
    inTarget = inTarget.Resize(resRows, 4)
    g = 1
    For i = 1 To srcRows
        For j = 0 To 3
            inTarget.Item(g + j, 1) = inSource.Item(i, 1)      '' Tag
            inTarget.Item(g + j, 2) = inSource.Item(i, 2)      '' SKU
            inTarget.Item(g + j, 3) = resNames(j)              '' Property
            inTarget.Item(g + j, 4) = inSource.Item(i, j + 3)  '' Value
        Next j
        g = g + propNum
    Next i
End Sub

This is the revised call sourcing the wider range.

'' Call ReOrgV2 with input and output ranges
Public Sub test4()
    Dim i As Integer
    i = Range("InData!A:A").Find("").Row - 2
    reOrgV2 Range("InData!A2").Resize(i, 6), [OutData!A1]
End Sub

edited Sep 23, 2010 at 1:18

community wiki

12 revs
Marc Thibault

Sign up to request clarification or add additional context in comments.

9 Comments

Bob Over a year ago

For reOrgV1, it stopped after the 3rd row of InData. For reOrgV2, I rcv'd Run-time error '13': Type mismatch with inTarget.Item(g + j, 2) = Int(inSource.Item(i, 2)) highlighted.

Bob Over a year ago

Great, both are working. However, the output needs to be adjusted to Column A for TAG, Column B for SKU, Column C for Size,Grade,Location & Column D for 12,A,X1. Current output has 3 columns & I need to present it in 4 columns.

Bob Over a year ago

BTW, how can i start the conversion without defining the ranges ? U see, some of the InData files may hv just 2 rows & some, a few thousand rows. So, it's kinda tedious to keep adjusting the ranges before I can perform the conversion.

Bob Over a year ago

Added the size input array & it prompted with Run-time error '1004': Select method of Range class failed with Range("InData!A2").Select highlighted.

Bob Over a year ago

Added test3() & it prompted with Run-time error '424: Object required with reOrgV2 Range("InData!A2").Resize(i, 5), [OutData!A1] highlighted.

|

Fionnuala · Accepted Answer · 2010-09-13 11:12:09Z

0

You can use ADO with Excel. Roughly:

Sub ColsToRows()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

    ''This is not the best way to refer to the workbook
    ''you want, but it is very convenient for notes
    ''It is probably best to use the name of the workbook.

    strFile = ActiveWorkbook.FullName

    ''Note that if HDR=No, F1,F2 etc are used for column names,
    ''if HDR=Yes, the names in the first row of the range
    ''can be used.
    ''This is the Jet 4 connection string, you can get more
    ''here : http://www.connectionstrings.com/excel

     strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Docs\TestBook.xls " _
            & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

    ''Late binding, so no reference is needed

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")


    cn.Open strCon

    strSQL = "SELECT [TAG], [SKU], 'SIZE ' & [SIZE] As S, " _
           & "'GRADE ' & [GRADE] As G, 'LOCATION ' & [LOCATION] As L " _
           & "FROM [Sheet1$] a " _
           & "ORDER BY [Tag] "

    rs.Open strSQL, cn, 3, 3


    ''Pick a suitable empty worksheet for the results

    With Worksheets("Sheet3")

        j = 1 '' Row counter

        Do While Not rs.EOF
            For i = 2 To 4
                .Cells(j, 1) = rs!Tag
                .Cells(j, 2) = rs!SKU
                .Cells(j, 3) = rs(i)
                j = j + 1
            Next
            rs.MoveNext
        Loop
    End With

   ''Tidy up
   rs.Close
   Set rs = Nothing
   cn.Close
   Set cn = Nothing

End Sub

edited Sep 13, 2010 at 11:12

answered Sep 13, 2010 at 9:57

Fionnuala

91.4k7 gold badges121 silver badges155 bronze badges

6 Comments

Bob Over a year ago

I tried the above & prompted with Run-time error '-2147467259 (80004005)': Invalid argument with cn.Open strCon highlighted.

Fionnuala Over a year ago

Once again, fairly standard VBA seems to be causing problems for you, so I wonder which version of Excel are you using? What is your operating system?

Fionnuala Over a year ago

Okay, what both these problems have in common seems to be the active sheet or workbook. I have edited the strCon line to refer to the name of a workbook, please change it to refer to the full name and path for the test workbook.

Fionnuala Over a year ago

One more thing occurs to me, what is your locale?

Fionnuala Over a year ago

Locale is similar to country and setting the locale for an application or computer determines things like currency delimiters (, or .) and also some odd bits and pieces in VBA.

|

Marc Thibault · Accepted Answer · 2010-09-13 20:10:17Z

Here's a really simple solution that assumes the dataset isn't huge. It takes the input range into an array, transforms it into a result array, then moves the array to the specified target. The target is defined by the top left cell.

When it's possible, this approach is orders of magnitude faster than working directly with cells on worksheets.

The test function at the bottom needs you to put an input set on sheet InData and have a sheet OutData defined for the results but your input and output ranges can be anywhere you want.

Option Explicit

Public Sub reOrgV1(inSource As Range, inTarget As Range)
'' This version uses VBA arrays to do the work.
'' Takes a source range, reorganizes it to the target
''    given as the top-left cell of the result.

    Dim srcArray As Variant
    Dim resArray As Variant
    Dim resNames()
    resNames = Array("SIZE", "GRADE", "LOCATION")

    Dim srcRows As Integer
    Dim resRows As Integer
    Dim i As Integer
    Dim j As Integer
    Dim g As Integer

    '' Move range into source array
    srcArray = inSource.Value
    srcRows = UBound(srcArray, 1)
    resRows = srcRows * 3

    ''Build result array
    ReDim resArray(1 To resRows, 1 To 3)

    '' transfer source to result array
    g = 1
    For i = 1 To srcRows
        For j = 0 To 2
            resArray(g + j, 1) = srcArray(i, 1)
            resArray(g + j, 2) = srcArray(i, 2)
            resArray(g + j, 3) = resNames(j) & " " & srcArray(i, j + 3)
        Next j
        g = g + 3
    Next i

    '' Move the results to the target range
    inTarget.Resize(resRows, 3).Value = resArray
End Sub

Public Sub test1()
    reOrgV1 Range("InData!A2:E4"), Range("OutData!A1")
End Sub

Collectives™ on Stack Overflow

Convert row with columns of data into column with multiple rows in Excel

3 Answers 3

9 Comments

6 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

9 Comments

6 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related