Create a matrix from data in three column

[sa02000]

I have data in three columns. I would like to take this data and create
a matrix from this data.
So, data in columnA become column labels in matrix, data in ColumnB
become row lables in matrix and data in columnC populates the matrix
(crossection of columnA and ColumnB values).

I would prefer if this is done via macro/VBA but a formula will be fine
too.

Thanks for help in advance.
Jay

 

[JonR]

Here's some code that should do the trick (modified from one of my earlier
posts). It also eliminates any duplicate values in your row and column
headings

Sub Strata()

Worksheets("Sheet1").Activate 'Makes sure you're starting on the right sheet

Dim inRow, inCol, stVal, dtDate, inNum, inX ' declare variables


'Gather values for row and column headings, and eliminate duplicates

Cells(1, 1).Activate

inRow = ActiveCell.End(xlDown).Row

For inCol = 1 To 2

Range(Cells(1, inCol), Cells(inRow, inCol)).Copy

Worksheets("Sheet3").Activate ' using sheet 3 for a workspace

Cells(1, 1).PasteSpecial

Selection.SortSpecial

inX = 1

'eliminates duplicate values

Do Until Cells(inX, 1).Value = ""

If Cells(inX + 1, 1).Value = Cells(inX, 1).Value Then
Cells(inX + 1, 1).Delete
Else
inX = inX + 1
End If
Loop



inX = 1

'Put row and column headings into Sheet 2

If inCol = 2 Then

Do Until Worksheets("Sheet3").Cells(inX, 1).Value = ""

Worksheets("Sheet2").Cells(1, inX + 1).Value =
Worksheets("sheet3").Cells(inX, 1).Value
inX = inX + 1

Loop

Else
Do Until Worksheets("Sheet3").Cells(inX, 1).Value = ""
Worksheets("Sheet2").Cells(inX + 1, 1).Value =
Worksheets("Sheet3").Cells(inX, 1).Value
inX = inX + 1
Loop
End If

Worksheets("Sheet1").Activate

Next inCol

' Get Row and Column ends to populate data

Worksheets("sheet2").Activate

Cells(1, 2).Activate
inCol = ActiveCell.End(xlToRight).Column
Cells(2, 1).Activate
inRow2 = ActiveCell.End(xlDown).Row


inRow = 1

'Populates data into Sheet 2

Do Until Worksheets("Sheet1").Cells(inRow, 3).Value = ""

dtDate = Worksheets("Sheet1").Cells(inRow, 1).Value
inNum = Worksheets("Sheet1").Cells(inRow, 2).Value
stVal = Worksheets("Sheet1").Cells(inRow, 3).Value

With Range(Cells(1, 2), Cells(1, inCol))
Set c = .Find(inNum)
inPasteCol = c.Column
End With

With Range(Cells(2, 1), Cells(inRow2, 1))
Set c = .Find(dtDate)
inPasteRow = c.Row
End With

'Populate data into cells in Sheet 2

If Cells(inPasteRow, inPasteCol).Value = "" Then

Cells(inPasteRow, inPasteCol).Value = stVal

Else

'this statement will concatenate stVal onto any cells where you have
duplicate date/row entries

Cells(inPasteRow, inPasteCol).Value = Cells(inPasteRow,
inPasteCol).Value & " ," & stVal

End If

inRow = inRow + 1

Loop

End Sub

 

[JLatham]

An alternative? I wasn't sure which way your data for the matrix values is
laid out in column C, so wrote code to deal with it either being grouped by
the matrix columns or by the matrix rows. Choose which method to use by
setting the variable DataIsByRows to either True or False just ahead of the
code that moves that information.

Sub CreateMatrix()
'General Assumptions:
'sheet with data is currently active
'there is at least 1 row title
'there is at least 1 column title
'
'there is data for all cells in the matrix
'
Dim RowCount As Long
Dim RL As Long ' loop counter
Dim ColumnCount As Integer
Dim CL As Integer ' loop counter
'change these constants as appropriate for your
'layout
Const ULCorner = "H1" ' upperleft corner of matrix to build
Const RowLabels = "A1"
Const ColLabels = "B1"
Const MatrixData = "C1"
Dim DataIsByRows As Boolean ' flag to be set later by YOU
'
'get the Row headers and keep count
'assumption: row headers are in column A
'begin at A1 and continue unbroken to end of list
'
'Building matrix with H1 as upper left corner
'
RowCount = 0 ' initialize
Do Until IsEmpty(Range("A1").Offset(RowCount, 0))
Range(ULCorner).Offset(RowCount + 1, 0) = _
Range("A1").Offset(RowCount, 0)
RowCount = RowCount + 1
Loop
'
'get column headers
'
ColumnCount = 0 ' initialize
Do Until IsEmpty(Range("B1").Offset(ColumnCount, 0))
Range(ULCorner).Offset(0, ColumnCount + 1) = _
Range("B1").Offset(ColumnCount, 0)
ColumnCount = ColumnCount + 1
Loop
'
'two solutions are provided for filling the matrix data
'which to use depends on how the 'raw data' in a column
'is laid out.
' Set variable DataIsByRows = TRUE to use
' Method 1, set it to = FALSE to used Method 2
' currently set to Method 1 - right here:
DataIsByRows = True
'***********************
If DataIsByRows = True Then
'
'fill matrix - Method 1
'use when raw data is sequenced in row groups
For RL = 1 To RowCount
For CL = 1 To ColumnCount
Range(ULCorner).Offset(RL, CL) = _
Range("C1").Offset(((RL * ColumnCount) - ColumnCount) +
(CL - 1), 0)
Next
Next

Else ' executed when DataIsByRows set = FALSE
'
'fill matrix - method 2
'use when raw data is sequenced in column groups
For CL = 1 To ColumnCount
For RL = 1 To RowCount
Range(ULCorner).Offset(RL, CL) = _
Range("E1").Offset(((CL * RowCount) - RowCount) + (RL -
1), 0)
Next
Next
End If
End Sub

 

[JLatham]

I should probably explain that the code I provided makes two possibly
incorrect assumptions about the data in columns A and B:
That the list of row headers and column headers in those columns only appear
once, as a simple list for each. If it appears otherwise, if you use that
code, then make 2 lists in 2 columns and point the code to them.