Yesterday I had to deal with a data file that looked a little like this only  it spread out across 455 columns and was frankly useless.

I wrote a post a while back that demonstrated how to convert a simple cross tab back to a manageable data list but I wanted to expand this with a slightly more complex example which had more field headings.

So starting with the table above which was probably a pasted copy from a pivot table I applied a little bit of formatting to achieve the following starting table.

What I have done is remove the grouping that the pivot table applies and ensured that I have the relevant  week number, project and department details against each name

I often wish to convert pivot table outputs back into a data file and the way I fill in the blanks caused by grouping data is to prepare a sheet with formulas that copy values from above (or the side as appropriate):

I then copy the pivot table data and then use the paste special command selecting paste values and skip blanks as the options.

This results in the following output, which I then copy and paste over itself as values, to give me the desired structure.

Having spent a bit of time on the structure of my starting file I can run the macro that will work through each row and transpose the data from a columnar layout to one based on rows.

The advantage of this format is that I can now create my own pivot tables and cut the data as I see fit to produce multiple summary formats according to my audience.

Here’s the macro I use:

Sub CrossTabToList()

Dim wsCrossTab As Worksheet
Dim wsList As Worksheet
Dim iLastCol As Long
Dim iLastRow As Long
Dim iLastRowList As Long
Dim rngCTab As Range ‘Used for range in Sheet1 cross tab sheet
Dim rngList As Range ‘Destination range for the list
Dim ROW As Long

Set wsCrossTab = Worksheets(“Sheet1″) ‘AMEND TO SHOW SHEET NUMBER WITH THE CROSS TAB
Set wsList = Worksheets.Add

‘Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, “A”).End(xlUp).ROW

‘Set the initial value for the row in the destination worksheet
iLastRowList = 2

‘Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range(“A2″).End(xlToRight).Column

‘SET THE HEADING TITLES IN THE LIST SHEET
wsList.Range(“A1:F1″) = Array(“NAME”, “PROJECT”, “TYPE”, “PLAN/ACTUAL”, “WEEK”, “HOURS”)

‘Start looping through the cross tab data

For ROW = 3 To iLastRow ‘START AT ROW 3 AS THIS IS WHERE DATA BEGINS
Set rngCTab = wsCrossTab.Range(“A” & ROW, “C” & ROW) ‘initial value A3 SETS THE RANGE TO

‘INCLUDE ALL STATIC DATA – IN THIS CASE NAME, PROJECT, TYPE
Set rngList = wsList.Range(“A” & iLastRowList) ‘initial value A3

‘Copy individual names in Col A (A3 initially) into as many rows as there are data columns
‘in the cross tab (less 3 for Col A-C).
rngCTab.Copy rngList.Resize(iLastCol – 3)

‘SELECT THE HEADING ROW WITH FORECAST/ACTUAL
‘Move up ROW (INITIALLY 3) rows less TWO and across 3 columns (using offset function). Copy.
rngCTab.Offset(-(ROW – 2), 3).Resize(, iLastCol – 3).Copy

‘Paste transpose to columns in the list sheet alongside the static data
rngList.Offset(0, 3).PasteSpecial Transpose:=True

‘SELECT THE ROW WITH THE WEEK NUMBERS
‘Move up ROW (INITIALLY 3) rows less ONE and across 3 columns (using offset function). Copy.
rngCTab.Offset(-(ROW – 1), 3).Resize(, iLastCol – 3).Copy

‘Paste transpose to columns in the list sheet alongside the static data
rngList.Offset(0, 4).PasteSpecial Transpose:=True

‘Staying on same row (3 initially) copy the data from the cross tab
rngCTab.Offset(, 3).Resize(, iLastCol – 3).Copy

‘Past transpose as column in list sheet
rngList.Offset(0, 5).PasteSpecial Transpose:=True

‘Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol – 3)

‘increment ROW by 1
Next ROW

End Sub

I’ve amended array sorting code from John Walkenbach and Anthony’s VBA Tutorials to create something I can understand.

The DbleBubbleSort routine takes two arrays as arguments and sorts the string array (y) on the basis of the values in a nuber array (x). I’m using John Walkenbachs BubbleSort methodology which is simple but undoubtedly not the most efficient.

Sub DbleBubbleSort(x() As Single, y() As String)

‘ adapting the BubbleSort method to sort an array on the basis of the values in another array.
‘ x is an array of numbers (can be random as in the DbleSortTest() routine)
‘ y is a string array
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim xtemp As Single
    Dim ytemp As String
   
    First = LBound(x)
    Last = UBound(x)
    For i = First To Last – 1
        For j = i + 1 To Last
            If x(i) > x(j) Then
                xtemp = x(j)
                ytemp = y(j)
                x(j) = x(i)
                y(j) = y(i)
                x(i) = xtemp
                y(i) = ytemp
            End If
        Next j
    Next i
End Sub

The following routine calls on the DbleBubbleSort sub routine and uses it to provide a random selection of 3 entries from a string array.

Sub DbleSortTest()
‘this is an amended version of a function on http://www.anthony-vba.kefra.com/vba/excelvba-simulation.htm#Creating_and_Managing_Array
‘it randomly selects 3 entries from a text array (y)
‘it utilises a random number array and the sorting of one array based on the values in another.

    Dim i As Long
    Dim x(8) As Single, y(8) As String
    Dim str As String

    y(1) = “Anthony”
    y(2) = “Bobby”
    y(3) = “Chris”
    y(4) = “Danny”
    y(5) = “Eton”
    y(6) = “Frank”
    y(7) = “George”
    y(8) = “Harry”
   
    ‘enters the x array into a worksheet
    For i = 1 To UBound(x)
        x(i) = Rnd
        Cells(i, 2) = x(i)
    Next i
   
    ‘enters the y array in column 3 of the worksheet
    For i = 1 To UBound(y)
        Cells(i, 3) = y(i)
    Next i
   
    Call DbleBubbleSort(x, y)
   
    ‘calls the first 3 values of y sorted according to x and enters them in the worksheet
    str = “”
    For i = 1 To 3
        str = str & y(i) & vbCrLf
        Cells(i, 1) = y(i)
    Next i

    MsgBox str
End Sub

These particular snippets are useful routines for sorting arrays and can be called from other procedures. I’ve taken these particular ones from John Walkenbach’s book: Excel 2007 Power Programming with VBA. I’m working my way through Anthony’s VBA tutorials for excel modelling and array sorting is regular feature.

The BubbleSort code is easy to understand and therefore one of my favourites but the other 3 methods are much quicker for arrays with more than 500 entries.

Sub BubbleSort(list() As String)
‘ Taken from power programming with VBA
‘ It’s a sorting procedure for 1-dimensional arrays named List
‘ The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
‘ The evaluation is repeated for every pair of items (that is n-1 times)
‘ Change data type to As Integer if your array isn’t text
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim temp As String
    First = LBound(list)
    Last = UBound(list)
    For i = First To Last – 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                temp = list(j)
                list(j) = list(i)
                list(i) = temp
            End If
        Next j
    Next i
End Sub

You can test this macro with the following routine which pastes the results into the immediate window.

Sub SortTester()
   
    Dim x(1 To 5) As String
    Dim i As Long
   
    x(1) = “egg”
    x(2) = “apple”
    x(3) = “stuff”
    x(4) = “nonsense”
    x(5) = “1″
   
    Call BubbleSort(x)
   
    For i = 1 To 5
        Debug.Print i, x(i)
    Next i
End Sub

Here are a few more sort options which are a bit more efficient but unfortunately more complex.

Sub WorksheetSort(list)
‘   Sorts an array by transferring it to
‘   A worksheet and using Excel’s sorting command
   
    Dim First As Integer, Last As Long
    Dim i As Long
    Dim FirstCell As Range, LastCell As Range
    Dim CurrCell As Range, FillRange As Range
   
    First = LBound(list, 1)
    Last = UBound(list, 1)
    Set FirstCell = Sheets(“Sheet1″).Cells(1, 1)
    Set LastCell = Sheets(“Sheet1″).Cells(Last, 1)
    Set FillRange = Range(FirstCell, LastCell)
    Application.ScreenUpdating = False
   
‘   Transfer the array to worksheet
    FillRange.Value = list
   
‘   Sort the worksheet range
    FirstCell.CurrentRegion.Sort Key1:=FirstCell, Order1:=xlAscending, Orientation:=xlTopToBottom
      
‘   Transfer range back to the array and clear range
    For i = First To Last
        list(i, 0) = FirstCell.Offset(i – 1, 0)
    Next i
    FillRange.Clear
    Application.ScreenUpdating = True
End Sub

Public Sub Quicksort(list() As Long, ByVal min As Long, ByVal max As Long) 
‘This technique works only with Integer or Long values.
Dim med_value As Long
    Dim hi As Long
    Dim lo As Long
    Dim i As Long

    ‘ If min >= max, the list contains 0 or 1 items so it
    ‘ is sorted.
    If min >= max Then Exit Sub

    ‘ Pick the dividing value.
    i = Int((max – min + 1) * Rnd + min)
    med_value = list(i)

    ‘ Swap it to the front.
    list(i) = list(min)

    lo = min
    hi = max
    Do
        ‘ Look down from hi for a value < med_value.
        Do While list(hi) >= med_value
            hi = hi – 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            list(lo) = med_value
            Exit Do
        End If

        ‘ Swap the lo and hi values.
        list(lo) = list(hi)
       
        ‘ Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While list(lo) < med_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            list(hi) = med_value
            Exit Do
        End If
       
        ‘ Swap the lo and hi values.
        list(hi) = list(lo)
    Loop
   
    ‘ Sort the two sublists.
    Quicksort list(), min, lo – 1
    Quicksort list(), lo + 1, max
End Sub

Sub Countingsort(list)
‘This technique works only with Integer or Long values.
Dim counts()
    Dim i As Long
    Dim j As Long
    Dim next_index As Long
    Dim min, max
    Dim min_value As Variant, max_value As Variant

‘   Allocate the counts array. VBA automatically
‘   initialises all entries to 0.

    min_value = Minimum(list)
    max_value = Maximum(list)

    min = LBound(list)
    max = UBound(list)
   
    ReDim counts(min_value To max_value)
   
    ‘ Count the values.
    For i = min To max
        counts(list(i)) = counts(list(i)) + 1
    Next i

    ‘ Write the items back into the list array.
    next_index = min
    For i = min_value To max_value
        For j = 1 To counts(i)
            list(next_index) = i
            next_index = next_index + 1
        Next j
    Next i
End Sub

Function Minimum(list)
    Dim i As Long
    Minimum = list(LBound(list))
    For i = LBound(list) To UBound(list)
        If list(i) < Minimum Then Minimum = list(i)
    Next i
End Function

Function Maximum(list)
    Dim i As Long
    Maximum = list(LBound(list))
    For i = LBound(list) To UBound(list)
        If list(i) > Maximum Then Maximum = list(i)
    Next i
End Function

I’ve recently had to recreate these delete row macros to install on a new computer and thought it would be useful to keep them filed here on the blog.

This first macro will delete any row in which the cell in the selected column is blank. So in this example, with column B selected, rows 4 & 7 will be deleted.

Sub DeleteRowOnBlankCell()

‘Deletes entire row within the selected column where cell within selection is blank

‘Select column then run the macro

On Error Resume Next

Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete

On Error GoTo 0

End Sub

The following macro will only delete rows if the entire row is blank. Just select the area you want to evaluate and run the macro.

Sub DeleteBlankRows()

‘Deletes the entire row within the selection provided the ENTIRE row is blank.

Dim i As Long

For i = Selection.Rows.Count To 1 Step -1

If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then

Selection.Rows(i).EntireRow.Delete

End If

Next i

End Sub

To use these macros just copy and paste them into a module within your personal macro workbook (press ALT F11 to open the VBA editor) which will make them available for use whenever excel is open. Sometimes the personal workbook doesn’t show up in the VBA editor and if this is the case I just record a new macro, select the option to save it in the personal workbook, make a few changes to a spreadsheet and stop recording. This will have the effect of creating a new module in  personal.xls, along with a fairly useless macro that can now be deleted.

Unfortunately RANKIF isn’t one of the available functions but I managed to achieve the same effect by utilising the SUMPRODUCT function.

I wrote a SUMPRODUCT tutorial some time ago indicating how the powerful function can act as a multi conditioned SUMIF formula but it seems it can also act as a multi conditioned RANKIF formula as well.

The formula I used to achieve the above ranking was:

=1+SUMPRODUCT(($B$2:$B$12=B2)*($C$2:$C$12>C2))

Copied down the column it will return the number of organisations for a given procedure which have costs higher than the selected row. Adding 1 to the result just ensures that the highest cost organisation starts with a rank of 1 rather than 0.

Converting a table like this:

Back to the data sheet like this:

If you didn’t have to do this sort of task very often you could get by with a pivot table solution and a few stages of formatting but it would only work if your data values were numbers that could be summed in the pivot.

If you need to convert Excel data tables (or crosstabs) into flat lists on a regular basis then you will need a macro.

I have prepared a workbook that demonstrates both the pivot table and macro solution and you can download it from here:
ExcelTabletoFlatList.xls

The following macro does the trick and utilises the VBA I introduced in my last post on consolidating worksheets, to determine the last used row and last used column.

Sub CrossTabToList()

Dim wsCrossTab As Worksheet
Dim wsList As Worksheet
Dim iLastCol As Long
Dim iLastRow As Long
Dim iLastRowList As Long
Dim rngCTab As Range ‘Used for range in Sheet1 cross tab sheet
Dim rngList As Range ‘Destination range for the list
Dim I As Long

Set wsCrossTab = Worksheets(“Sheet1″)
Set wsList = Worksheets.Add

‘Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, “A”).End(xlUp).Row

‘Set the initial value for the row in the destination worksheet
iLastRowList = 2

‘Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range(“A1″).End(xlToRight).Column

‘Create a new sheet and set the heading titles
wsList.Range(“A1:C1″) = Array(“NAME”, “GRADE”, “VALUE”)

‘Start looping through the cross tab data

For I = 2 To iLastRow

Set rngCTab = wsCrossTab.Range(“A” & I) ‘initial value A2
Set rngList = wsList.Range(“A” & iLastRowList) ‘initial value A2

‘Copy individual names in Col A (A2 initially) into as many rows as there are data columns
‘in the cross tab (less 1 for Col A).
rngCTab.Copy rngList.Resize(iLastCol – 1)

‘Move up a I rows less one and across one column (using offset function) to select heading row. Copy.
rngCTab.Offset(-(I – 1), 1).Resize(, iLastCol – 1).Copy

‘Paste transpose to columns in the list sheet alongside the names
rngList.Offset(0, 1).PasteSpecial Transpose:=True

‘Staying on same row (2 initially) copy the data from the cross tab
rngCTab.Offset(, 1).Resize(, iLastCol – 1).Copy

‘Past transpose as column in list sheet
rngList.Offset(0, 2).PasteSpecial Transpose:=True

‘Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol – 1)

‘increment I by 1
Next I

End Sub

I want to group together all the used data on each tab and create a single consolidated sheet of continuous data.

Obviously I need a macro to copy and paste my data from each sheet but the tricky bit is selecting the relevant (or used) area in each sheet.

On my search around the interweb I found some really useful snippets of VBA code on the Ozgrid website which enable you to determine the last used row according to a number of different criteria and assign this to a variable such as “iLastRow”.

‘find row before next blank cell in column A
iLastRow = Range(“A1″).End(xlDown).Row

‘find last used row in column A
iLastRow = Cells(Rows.Count, “a”).End(xlUp).Row

‘find last used row on sheet
iLastRow = Cells.Find(what:=”*”, SearchOrder:=xlByRows, _SearchDirection:=xlPrevious).Row

It’s a simple step then to use this variable to define a range of used cells.

Range(“A1:P” & iLastRow).Select

I’ve used the above techniques to consolidate my worksheets and here’s a copy of my working code:

Sub ConsolidateSheetsforSubForm()

‘ ConsolidateSheetsforSubForm Macro

‘ Copies used subform data in individual sheets and pastes into one sheet as continuous data

Sheets(“Ap Table Sub Form”).Select

‘find last used row column a of Ap Table Sub Form sheet

ilastrowsubf = Cells(Rows.Count, “a”).End(xlUp).Row

‘ Clear the existing data in the subform sheet

‘specify location in subform to clear data

Range(“a5:k” & ilastrowsubf).ClearContents

‘ Start selecting the data from Sheet S&M (LY)

Sheets(“S&M (LY)”).Select

‘ find last used row in column I

ilastrowsm = Cells(Rows.Count, “i”).End(xlUp).Row

‘ use ilastrowsm variable to define range to copy in S&M sheet

Range(“i4:s” & ilastrowsm).Copy

‘ specify location in subform to paste data

Sheets(“Ap Table Sub Form”).Select

Range(“a5″).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets(“K&R (BV)”).Select

‘ find last used row in column I of K&R sheet

ilastrowkr = Cells(Rows.Count, “i”).End(xlUp).Row

‘ use ilastrowkr variable to define range to copy in K&R sheet

Range(“i4:s” & ilastrowkr).Copy

Sheets(“Ap Table Sub Form”).Select

‘ find first blank row in column a of Ap Table Sub Form sheet

ifirstblankrowsubf = (Cells(Rows.Count, “a”).End(xlUp).Row) + 1

‘ specify location in subform to paste data

Range(“a” & ifirstblankrowsubf).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets(“OVERHEADS”).Select

‘ find last used row in column I of OVERHEADS sheet

ilastrowover = Cells(Rows.Count, “i”).End(xlUp).Row

‘ use ilastrowover variable to define range to copy in OVERHEADS sheet

Range(“i4:s” & ilastrowover).Copy

Sheets(“Ap Table Sub Form”).Select

‘ find first blank row in column a of Ap Table Sub Form sheet

ifirstblankrowsubf = (Cells(Rows.Count, “a”).End(xlUp).Row) + 1

‘ specify location in subform to paste data

Range(“a” & ifirstblankrowsubf).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range(“A5″).Select

End Sub

You can do similar things in order to find the last column as well:

‘find column before next blank cell in row 1

iLastColumn = Range(“A1″).End(xlToRight).Column

‘find last used column in row 1

iLastColumn = Cells(Columns.Count, “a”).End(xlToLeft).Column

‘find last used column on sheet

iLastColumn = Cells.Find(what:=”*”, SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column

I had previously been using the double vlookup method to replace errors with blanks or zeros but then discovered that these excessive lookup functions had a tendency to bloat my spreadsheets.

While the conditional format method works, I can’t say that I particularly like it so I’ve been on the hunt for another method.

My first double lookup error hiding method looked like this:

=IF(ISERROR(VLOOKUP(L$7&$C13,’[WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,9,0)),””,VLOOKUP(L$7&$C13,’[WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,9,0))

and here’s method no 3 that feels somewhat neater:

=IF([WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,L$7&$C13),VLOOKUP(L$7&$C13,’[WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,9,0))

That’s a working formula but it is a bit confusing, so here’s a simpler example the syntax:

=IF(COUNTIF(A1:A10,”Some Value”),VLOOKUP(“Some Value”,A1:B10,2,FALSE),0)

The COUNTIF function is a logical function and will return TRUE or FALSE depending on whether “Some Value” is found in the range A1:A10. The IF function follows the format =IF(logical test, value if true, value if false). So if the COUNTIF function is TRUE the VLOOKUP will run, if it is FALSE the value 0 is returned.

I’ve been reading a bit about good spreadsheet design with a view to whittling down the complexity and discovered that lookup functions are particularly demanding on the system.

Now I’m quite a sinner when it comes to the use of the double lookup function to remove errors such as #N/A and #DIV/0!

Here’s an example of such a formula that returns a blank if the first lookup function results in an error:

=IF(ISERROR(VLOOKUP(L$7&$C13,’[WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,9,0)),”",VLOOKUP(L$7&$C13,’[WTE Apportionment Tables.xls]WTE APP TABLES SUB F’!$B:$K,9,0))

It works fine, but it doubles up the number of lookups that Excel needs to run through and for a large spreadsheet this can really slow down the performance.

It seems that conditional formatting is a suitable alternative but one that I’ve always ignored because I didn’t know how to structure the condition to work for errors.

I do now though and here’s how:

1. Select the range you wish to apply the format to.
2. Goto Format – Conditional Formatting
3. Select Formula Is in the drop down box
4. Type the formula =iserror(ref) where ref is the reference to the first cell selected in the range
5. Hit Format and select the font colour to be white
6. OK – finished the job

My current spreadsheet hasn’t grown that large yet but nevertheless it had 7200 of the double vlookups in 18 columns, by removing the unnecessary error catching lookup I dropped the file size by 22%.

As the errors weren’t actually removed, I had to use an array formula to get the totals for the column but that was included in the space saving above.

The array formula for summing a range with error values:

{=SUM(IF(ISNUMBER(H12:H418),(H12:H418)))}

NB. The curly brackets are achieved by entering the formula using CONTROL, SHIFT, ENTER.

Sub MultipleHeader()
‘created 10/01/2008 by Angela Wolff
Application.ScreenUpdating = False ‘ stops the flashing
Dim WS_Count As Integer
Dim I As Integer
‘ Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
‘ Begin loop.
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Activate
ActiveSheet.PageSetup.RightHeaderPicture.Filename = _
“C:\Document\hhnt_007528.jpg” ‘obviously change this to the image and path of your desire.
ActiveSheet.PageSetup.PrintArea = “”
With ActiveSheet.PageSetup
.RightHeader = “&G”
End With
Next I
End Sub

NB. The With End With code is only really required if you are going to change a number of parameters at once.