Not registered yet?
Register now! It is easy and done in 1 minute and gives you access to special discounts and much more!
I've got two posts, with usable code and downloadable workbook, on doing this in Excel/VBA on my blog:
Here's the code:
'List: The range to be normalized.
'RepeatingColsCount: The number of columns, starting with the leftmost,
' whose headings remain the same.
'NormalizedColHeader: The column header for the rolled-up category.
'DataColHeader: The column header for the normalized data.
'NewWorkbook: Put the sheet with the data in a new workbook?
'NOTE: The data must be in a contiguous range and the
'columns that will be repeated must be to the left,
'with the columns to be normalized to the right.
Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
NormalizedColHeader As String, DataColHeader As String, _
Optional NewWorkbook As Boolean = False)
Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet
'If the normalized list won't fit, you must quit.
If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
MsgBox "The normalized list will be too many rows.", _
vbExclamation + vbOKOnly, "Sorry"
'You have the range to be normalized and the count of leftmost rows to be repeated.
'This section uses those arguments to set the two ranges to parse
'and the two corresponding arrays to fill
FirstNormalizingCol = RepeatingColsCount + 1
NormalizingColsCount = .Columns.Count - RepeatingColsCount
Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
'Fill in every i elements of the repeating array with the repeating row labels.
For i = 1 To NormalizedRowsCount Step NormalizingColsCount
ListIndex = ListIndex + 1
For j = 1 To RepeatingColsCount
RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
'We stepped over most rows above, so fill in other repeating array elements.
For i = 1 To NormalizedRowsCount
For j = 1 To RepeatingColsCount
If RepeatingList(i, j) = "" Then
RepeatingList(i, j) = RepeatingList(i - 1, j)
'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
'Put the normal data in the same workbook, or a new one.
If NewWorkbook Then
Set wbTarget = Workbooks.Add
Set wsTarget = wbTarget.Worksheets(1)
Set wbSource = List.Parent.Parent
Set wsTarget = .Add(after:=.Item(.Count))
'Put the data from the two arrays in the new worksheet.
.Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
.Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList
'At this point there will be repeated header rows, so delete all but one.
.Range("1:" & NormalizingColsCount - 1).EntireRow.Delete
'Add the headers for the new label column and the data column.
.Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
.Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
You’d call it like this:
NormalizeList ActiveSheet.UsedRange, 4, "Variable", "Value", False
This is great; however I'm having trouble selecting the valid range. When I highlight the cells I'm trying to stack, it pulls in extra blank columns (probably from your baseball example). How do I delineate the relevant range before running the macro?
You'd change the calling line to:NormalizeList Selection, 4, "Variable", "Value", False or NormalizeList ActiveSheet.Range("A1:D100"), 4, "Variable", "Value", False or whatever the range should be.
NormalizeList Selection, 4, "Variable", "Value", False
NormalizeList ActiveSheet.Range("A1:D100"), 4, "Variable", "Value", False
Microsoft recently came out with Power Query, an Excel Add-In which adds a lot of interesting functions and capabilities to data manipulation from within Excel, including what you're looking for.
The actual function within the Add-In is called "Unpivot Columns", which is explained in this article. Here's the gist of it:
First create a Userform and name it Unpivot_Form with two RefEdit fields - rng_id and value_id and a submit/go button. I am also an R user and rng_id is the range that contains the id while value_id contains the value; both range inclusive of header.
Do two macro:
Another macro is within the submit/go button of the field:
Private Sub submit_Click()
'Code to unpivot (convert wide to long for excel)
Dim rng_id, rng_id_header, val_id As Range
Dim colvar, emptyrow, col As Integer
Dim new_sheet As Worksheet
'Put val_id range into a range object
Set val_id = Range(value_id.Value)
'Determine the parameter for the value id range
'This is used for the looping later on
numrows = val_id.Rows.Count
numcols = val_id.Columns.Count
'Resize changes the "block" to the size defined by the row and column
'Offset moves the "block"
Set rng_id_header = Range(range_id.Value).Resize(1)
Set rng_id = Range(range_id.Value).Offset(1, 0).Resize(numrows - 1)
Set new_sheet = Worksheets.Add
'Set up the first column and first batch of id vars
colvar = Range("XFD1").End(xlToLeft).Column + 1
Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Variable"
Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Value"
'Start populating the value ids
For col = 1 To numcols
'determine last row
emptyrow = Range("A65535").End(xlUp).Row + 1
'no need to activate to source to copy
rng_id.Copy new_sheet.Cells(emptyrow, 1)
'copy the variable
val_id.Offset(, col - 1).Resize(1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar), Cells(emptyrow + numrows - 2, colvar))
'copy the value
val_id.Offset(1, col - 1).Resize(numrows - 1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar + 1), Cells(emptyrow + numrows - 2, colvar + 1))
sn = .Resize(, .Columns.Count + 1)
For j = 4 To UBound(sn, 2) - 1
With Sheet2.Cells(2 + (UBound(sn) - 1) * (j - 4), 1)
.Resize(UBound(sn) - 1, 5) = Application.Index(sn, Evaluate("row(2:"
& UBound(sn) & ")"), Array(1, 2, 3,UBound(sn, 2), j))
.Resize(UBound(sn) - 1, 1).Offset(, 3) = sn(1, j)
This does not seem like a correct answer as it does not accept a variable for the number of id columns.
@KHeaney Actually, this answer hits Excel savant level. Did you try it? One minor change for this particular question... change the For j = 4... line to For j = 5... It works perfectly. This is spectacular mastery of Excel-VBA nuance. Excellent work, @snb.
For j = 4...
For j = 5...
@ExcelHero I did not test it, just quickly assessed it in the Triage queue.Honestly it probably would work well as it seems like it would properly iterate over the range needed. As I said in my comment though, I do not believe it accepts an input and I do not know the use case for the user so I went with what their question stated which was that it required an input from the user.
For anyone looking for a visual way to normalize excel data, see this video tutorial: