"Unpivot Technique" - Changing a Table Into A List

F

frankybenali

I am trying to reorganize a table into a list and have used the
"unpivot' technique described by John Walkenbach:

http://j-walk.com/ss/excel/usertips/tip068.htm

However, there is a problem because the created list is huge so will
not fit in the worksheet (not enough rows). It will fit in if blanks
are ignored. Is there a way that I can get the blanks to be ignored?
 
D

Dave Peterson

How about a macro?

Option Explicit
Sub testme()
Dim curWks As Worksheet
Dim newWks As Worksheet

Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long

Dim oRow As Long

Application.ScreenUpdating = False

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

newWks.Range("a1").Resize(1, 3).Value _
= Array("Month", "Product", "Sales")

With curWks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'headers in column A
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

If Application.CountA(.Range(.Cells(FirstRow, FirstCol), _
.Cells(LastRow, LastCol))) > (.Rows.Count - 1) Then
MsgBox "too much data"
Exit Sub
End If


oRow = 1
For iRow = FirstRow To LastRow
If iRow Mod 50 = 0 Then
Application.StatusBar = "Processing row#: " _
& iRow & " @ " & Now
End If
For iCol = FirstCol To LastCol
If IsEmpty(.Cells(iRow, iCol)) Then
'do nothing
Else
oRow = oRow + 1
newWks.Cells(oRow, "A").Value = .Cells(iRow, 1).Value
newWks.Cells(oRow, "B").Value = .Cells(1, iCol).Value
newWks.Cells(oRow, "C").Value = .Cells(iRow, iCol).Value
End If
Next iCol
Next iRow
End With

With Application
.StatusBar = False
.ScreenUpdating = True
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top