1

I have a row of data as follows:

             header1      header2      header3      header4      header5
  row key   datavalue1   datavalue2   datavalue3   datavalue4   datavalue5.... 

    CC     Corporate Leadership                 Community Funding Delivery 
   da1000              50%                                    50%

so basically, I have a denormalized data set where the datavalues may or may not be empty on a row-by-row basis. I need to normalize them.

ie

    CC         Activity                   Allocation                         
   da1000     Community Development         50%
   da1000     Community Funding Delivery    50%

etc

I could do this by using a paste special transform, but I have thousands of rows and I'd need to make sure that I get the right row key for each. furthermore, each row has a bunch of descriptives associated with it that I need copied over with each datavalue.

I have tried to use the following code however I'm getting a

Run-time Error 5 Invalid procedure call or argument

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  (CREDIT GOES TO Ben McCormack)
Fahad
  • 19
  • 3
  • There's another piece of code at this post that may work for you: http://stackoverflow.com/questions/10921791/melt-reshape-in-excel-using-vba/10922351#10922351 – Doug Glancy Dec 05 '12 at 21:59
  • Which line gives the error? – Dale M Dec 05 '12 at 22:37
  • Also, is there a reason for all the counters rather than just using the offset method of the range object i.e. `Set rngCurrent = rngCurrent.Offset(1,0)`? – Dale M Dec 05 '12 at 22:39
  • Fahad, your code worked perfectly for 100+ columns as a separate Sub. No errors (Excel 2003). What code generated the error message? – Jüri Ruut Dec 05 '12 at 22:43
  • Getting error on line wsNormalized.Range("B" & lngRowCounterNormalized).Value = clnHeader(CStr(lngColumnCounter)) – Fahad Dec 06 '12 at 14:28

0 Answers0