View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
JonR
 
Posts: n/a
Default Create a matrix from data in three column

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


"sa02000" wrote:


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


--
sa02000
------------------------------------------------------------------------
sa02000's Profile: http://www.excelforum.com/member.php...o&userid=27747
View this thread: http://www.excelforum.com/showthread...hreadid=555700