• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 889
  • Last Modified:

Normalize Excel data

I have data that looks like this in Excel

name      status     column1     column2      column3

I need the data to be transformed into

name    status     column1
name    status     column2
name    status     column3

The file has 75 rows and 34 columns that need to be transposed.
1 Solution
I generalized the sub so it could handle any number of fixed columns (name and status in your example) and variable columns (column1 through column 32 in your example). The macro asks the user to pick the data, header labels and destination of results.

If one of your Column1 through Column32 fields is blank, a new row for that datum will not be created.

You didn't request it, but most people asking a question like this need a fourth column that specifies which type of data is in the third column (e.g. Column1, Column2, etc.). The macro adds that column for you.
Sub Normalizer()
Dim rg As Range, rgHeaders As Range, targ As Range
Dim v As Variant, vHeaders As Variant, vv As Variant
Dim i As Long, j As Long, jj As Long, k As Long, nCols As Long, nFixedCols As Long, nRows As Long
nFixedCols = 2      'Each row  of reformatted data will have this many fixed columns. Another two columns will include the variable data & type.
On Error Resume Next
Set rg = Application.InputBox("Please select your data", Default:=Range("A1").CurrentRegion.Address, Type:=8)
If rg Is Nothing Then Exit Sub
Set rgHeaders = Application.InputBox("Please select your header labels", Default:=rg.Rows(1).Address, Type:=8)
Set targ = Application.InputBox("Where do you want results to go?", Default:=rg.Cells(1).Address, Type:=8)
If targ Is Nothing Then Exit Sub
On Error GoTo 0
Set rg = Intersect(rg.Worksheet.UsedRange, rg)
If Not rgHeaders Is Nothing Then
    Set rgHeaders = Intersect(rgHeaders, rg.EntireColumn)
    If rg.Row = rgHeaders.Row Then Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
End If
nCols = rg.Columns.Count
nRows = rg.Rows.Count
ReDim vHeaders(1 To nCols)
For j = 1 To nCols
    If rgHeaders Is Nothing Then
        vHeaders(j) = "Column " & j
        vHeaders(j) = rgHeaders.Cells(1, j).Value
    End If
v = rg.Value
ReDim vv(1 To nRows * (nCols - nFixedCols), 1 To nFixedCols + 2)
For i = 1 To nRows
    For j = nFixedCols + 1 To nCols
        If v(i, j) <> "" Then
            k = k + 1
            For jj = 1 To nFixedCols
                vv(k, jj) = v(i, jj)
            vv(k, nFixedCols + 1) = v(i, j)
            vv(k, nFixedCols + 2) = vHeaders(j)
        End If
ReDim Preserve vv(1 To k, 1 To nFixedCols + 2)
If Not Intersect(rg, targ.Resize(2)) Is Nothing Then
    If Not rgHeaders Is Nothing Then rgHeaders.ClearContents
End If
For jj = 1 To nFixedCols
    targ.Cells(1, jj).Value = vHeaders(jj)
targ.Cells(1, nFixedCols + 1).Value = "Value"       'Change label to suit
targ.Cells(1, nFixedCols + 2).Value = "Type"        'Change label to suit
targ.Cells(2, 1).Resize(k, nFixedCols + 2).Value = vv
End Sub

Open in new window

smolbeck367Author Commented:
byundt - this worked beautifully. I adjusted it to fit the number of columns my data had and ran it this morning. Thank you very much for the help. This has saved me a significant amount of time. I have a few more tweaks to make to my spreadsheet in order to call it complete but this got me 80 % there.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Train for your Pen Testing Engineer Certification

Enroll today in this bundle of courses to gain experience in the logistics of pen testing, Linux fundamentals, vulnerability assessments, detecting live systems, and more! This series, valued at $3,000, is free for Premium members, Team Accounts, and Qualified Experts.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now