Is it possible?

[JA]

Is it possible to transpose Table 1 to Table 2 using
macros?

TABLE 1
Start_Date Course Duration
08/05/04 A 2
09/05/04 B 1
09/05/04 C 3
08/05/04 D 3
10/05/04 E 2

TABLE 2
08/05/04 09/05/04 10/05/04 11/05/04
A A
B
C C C
D D D
E E

 

[Bob Phillips]

Here is a macro to place it on an other sheet

Sub transpose()
Dim cRows As Long
Dim cCols As Long
Dim cNewRow As Long
Dim i As Long
Dim oCell As Range

cRows = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To cRows
With Worksheets("Sheet2")
cNewRow = Asc(Cells(i, "B").Value) - 64
cCols = .Cells(1, Columns.Count).End(xlToLeft).Column
If .Range("A1") = "" Then
cCols = 0
Set oCell = Nothing
Else
Set oCell = .Range("A1").Resize(1, cCols).Find(Cells(i,
"A").Value, , xlFormulas)
End If
If oCell Is Nothing Then
.Cells(1, cCols + 1).Value = Cells(i, "A").Value
.Cells(cNewRow + 1, cCols + 1).Value = Cells(i, "B").Value
Else
.Cells(1, oCell.Column).Value = Cells(i, "A").Value
.Cells(cNewRow + 1, oCell.Column).Value = Cells(i,
"B").Value
End If
Set oCell = Nothing
End With
Next i
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[JA]

I am expriencing compile error at the following lines:

Set oCell = .Range("A1").Resize(1, cCols).Find(Cells(i,
"A").Value, , xlFormulas)

..Cells(cNewRow + 1, oCell.Column).Value = Cells(i,
"B").Value

 

[Frank Kabel]

Hi
these are both only ONE line. Combine them to a single line and it
should work

 

[Bob Phillips]

Thank you sir, distracted with setting up a water feature in the garden on
this gorgeous late spring day.

Bob

 

[Soo Cheon Jheong]

Hi,

With Worksheets("Sheet2")
.Range("A1").Formula = "=MIN(Sheet1!$A$2:$A$6)"
.Range("B11").Formula = "=DATE(YEAR(A1),MONTH(A1)+1,DAY(A1))"
.Range("A2:A6").Formula = "=IF(Sheet1!$A2=A$1,Sheet1!$B2,"""")"
.Range("B26").Formula =
"=IF(COUNTIF($A2:A2,""?"")<Sheet1!$C2,Sheet1!$B2,"""")"
.Range("A16").Value = .Range("A16").Value
End With

--
Regards,
Soo Cheon Jheong
Seoul, Korea
http://excel.hompy.com
_ _
^¢¯^
--

 

[Soo Cheon Jheong]

.Range("B26").Formula =
"=IF(COUNTIF($A2:A2,""?"")<Sheet1!$C2,Sheet1!$B2,"""")"

==> .Range("B26").Formula =
"=IF(AND(COUNTIF($A2:A2,""?"")<Sheet1!$C2,Sheet1!$A2<=B$1),Sheet1!$B2,"""")"


--
Regards,
Soo Cheon Jheong
Seoul, Korea
http://excel.hompy.com
_ _
^¢¯^
--

 

[JA]

Hi Bob,
Thanks for the effort, but the output (below) is not
exactly the expected. Can you help further.

08/05/04 09/05/04 10/05/04
A
B
C
D
E

 

[JA]

Hi Bob,
Thanks for the effort, but the output (below) is not
exactly the expected. Can you help further.

08/05/04 09/05/04 10/05/04
A
B
C
D
E

 

[JA]

Hi Bob,
Thanks for the effort, but the output (below) is not
exactly the expected. Can you help further.

08/05/04 09/05/04 10/05/04
A
B
C
D
E

 

[JA]

Thanks very much.
Can I get it also the other way round as well? Transpose
Table 2 to Table 1

Table 2
05/08/04 06/08/04 07/08/04 08/08/04
A A
B
C C C
D D D
E E

Table 1
Start_Date Course Duration
05/08/04 A 2
06/08/04 B 1
06/08/04 C 3
05/08/04 D 3
06/08/04 E 2

 

[Bob Phillips]

JA,

You will n eed to tell me in words how the output is wrong because I cannot
un derstand your post layout, and it does what I understood from your
original message.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Soo Cheon Jheong]

James,
Try:

' Tabel 1 => Sheet1
' Tabel 2 => Sheet2


'Module1:
'---------------------------------------------------------------------------
Sub Summary_2()

R = Worksheets("Sheet2").Range("A11").CurrentRegion.Rows.Count
If R < 2 Then Exit Sub

With Worksheets("Sheet1")
.Range("A:C").ClearContents
.Range("A1:C1").Value = Array("Start_Date", "Course", "Duration")
.Range("A2:A" & R).Formula =
"=INDEX(Sheet2!$A$1:$D$1,MATCH(B2,Sheet2!A22,0))"
.Range("B2:B" & R).Formula =
"=INDEX(Sheet2!A22,MATCH(""*?*"",Sheet2!A22,0))"
.Range("C2:C" & R).Formula = "=COUNTIF(Sheet2!$A$2:$D$6,B2)"
.Range("A2:C" & R).Value = .Range("A2:C" & R).Value
End With

End Sub


--
Regards,
Soo Cheon Jheong
Seoul, Korea
_ _
^¢¯^
--