Excel CrossTab Table to Flat List

I had a query on my sumproduct tutorial that was effectively asking if I could work backwards from an excel crosstab or data table to get back to the simple flat list.

Converting a table like this:

sumproduct

Back to the data sheet like this:

sumproduct

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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

Macros to Consolidate Worksheets

I’ve got a spreadsheet with tabs for each individual directorate. Within the tabs are tables with the same layout but different sizes (number of rows).

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”.

1
2
'find row before next blank cell in column A
iLastRow = Range("A1").End(xlDown).Row
1
2
'find last used row in column A
iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
1
2
'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.

1
Range("A1:P" & iLastRow).Select

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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:

1
2
3
4
5
6
7
8
9
'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

Adding an Image to the Header or Footer of Every Sheet

From Excel 2002 onwards you can enter an image, probably a logo, into the header or footer of your worksheet. This code enables you to create a macro that will automate the addition of the logo to every sheet in your workbook.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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.