Re: Normalising XL crosstabs for records
If this is teaching granny to suck eggs, apologies.
But Ive just solved this one after x years, and working on the basis that if it's a problem for me, theres every chance its a problem for someone else out there too;
So data comes in and the recorder has already nicely crosstabulated it to give you a series of rows and columns with quantities in the matrix.
Not very helpful when you want to import that into Recorder.
Heres a very basic xl macro to harvest crosstab tables for records, that I finally found on the net.
Note that it is unsophisticated and hence overwrites the cells it is harvesting from. (copy crosstab to empty sheet before applying macro).
It clearly needs improving but time, vb skills and time as usual are lacking.
If anyone has a better macro - happy to hear about it, or if anyone wants to improve this one!
Sub normalize()
' Takes a matrix with names in rows and columns and turns it into a
' normalized version.
' Names for rows and columns are expected to be outside the selection
' Cell {-1,-1} is an attribute to be repeated in all entries
' Spreadsheet name is an attribute to be repeated in all entries
' Will modify the row and column structure of the spreadsheet
' Will overwrite anyting in the destination area
' Will not check if there is enough space on the spreadsheet
Dim ss As Range
Dim rr As Integer, cc As Integer
Dim startRow As Integer, startCol As Integer
Set ss = Selection
rr = ss.Rows.Count
cc = ss.Columns.Count
If rr < 2 Then GoTo normalize_done
If cc < 2 Then GoTo normalize_done
startRow = ss.Row
startCol = ss.Column
If startRow < 2 Then GoTo normalize_done
If startCol < 2 Then GoTo normalize_done
' Copy all the data transposed into rows
For ci = 2 To cc
Application.Intersect(ss, Columns(startCol + ci - 1)).Copy
Cells(startRow + rr * (ci - 1), startCol).PasteSpecial xlPasteValues
Next ci
' Copy the row names in all the transposed rows
Range(Cells(startRow, startCol - 1), Cells(startRow + rr - 1, startCol - 1)).Copy
Range(Cells(startRow + rr, startCol - 1), Cells(startRow + rr * cc - 1, startCol - 1)).PasteSpecial xlPasteValues
Dim v As String
v = ActiveSheet.Name
' Copy the column names, matrix name and sheet name in each of the rows
For ci = 1 To cc
Cells(startRow - 1, startCol + ci - 1).Copy
Range(Cells(startRow + rr * (ci - 1), startCol + cc), _
Cells(startRow + rr * ci - 1, startCol + cc)).PasteSpecial xlPasteValues
Cells(startRow - 1, startCol - 1).Copy
Range(Cells(startRow + rr * (ci - 1), startCol + cc + 1), _
Cells(startRow + rr * ci - 1, startCol + cc + 1)).PasteSpecial xlPasteValues
Range(Cells(startRow + rr * (ci - 1), startCol + cc + 2), _
Cells(startRow + rr * ci - 1, startCol + cc + 2)).Value = v
Next ci
' Move the last columns back to be closer to the data and clean up
Range(Cells(startRow, startCol + cc), _
Cells(startRow + rr * cc - 1, startCol + cc + 2)).Cut _
Destination:=Range(Cells(startRow, startCol + 1), _
Cells(startRow + rr * cc - 1, startCol + 3))
Range(Cells(startRow - 1, startCol + 4), _
Cells(startRow + rr * cc - 1, startCol + cc + 2)).ClearContents
Range(Cells(startRow, startCol - 1), _
Cells(startRow + rr * cc - 1, startCol + 3)).Select
Selection.Style = "Normal"
Application.CutCopyMode = False
normalize_done:
End SubI leave it on the altar of offerrings.
MAtt
Tullie House Museum
