Working with Tables

[Alan in NJ]

Any help on the following would be appreciated:

Each week I download a table with three columns and numerous rows (generally
about 300). The first column contains the name of a public company each of
which is unique (i.e., there are about 300 companies each week and there are
no duplicates). The second column contains the one of five weekdays on
which they report their earnings: (M, T, W, TH or F). The third column
contains one of three time-of-day values: AM, PM or TBD ("to be
determined").

I need to write a macro that will "look at" each of the above rows and
assign each company to a new table with 15 columns (for each of the 5 days
and 3 times of day) and two rows (a heading row indicating the day and time,
e.g., "MONDAY-AM, MONDAY-PM, MONDAY-TBD, ETC.) simply place the names of
each of the companies in the proper column (i.e., all of the companies that
report on Monday AM will be in the same column).

I know I can sort, and then merge cells, and then cut-and-paste, but that is
very time consuming. I would like to automate it.

Thanks to all for any advice.
AlanS

 

[Cindy M -WordMVP-]

Hi Alan,

Each week I download a table with three columns and numerous rows (generally
about 300). The first column contains the name of a public company each of
which is unique (i.e., there are about 300 companies each week and there are
no duplicates). The second column contains the one of five weekdays on
which they report their earnings: (M, T, W, TH or F). The third column
contains one of three time-of-day values: AM, PM or TBD ("to be
determined").

I need to write a macro that will "look at" each of the above rows and
assign each company to a new table with 15 columns (for each of the 5 days
and 3 times of day) and two rows (a heading row indicating the day and time,
e.g., "MONDAY-AM, MONDAY-PM, MONDAY-TBD, ETC.) simply place the names of
each of the companies in the proper column (i.e., all of the companies that
report on Monday AM will be in the same column).

I know I can sort, and then merge cells, and then cut-and-paste, but that is
very time consuming. I would like to automate it.

Yeah, I'd want to automate it, too. Here's some sample code to get you going. I
haven't typed out everything for every column, but based on the pattern, you
should be able to complete it.

Sub ConvertTableData()
Dim tblSource As Word.Table
Dim tblTarget As Word.Table
Dim docSource As Word.Document
Dim docTarget As Word.Document
Dim rw As Word.Row
Dim rwNew As Word.Row
Dim iCellCounter As Long
Dim sCompanyName As String
Dim sReportTime As String

Set docSource = ActiveDocument
Set tblSource = docSource.Tables(1)
Set docTarget = Documents.Add
Set tblTarget = docTarget.Tables.Add(Range:=docTarget.Content, NumRows:=1,
NumColumns:=15)
With tblTarget.Rows(1)
.Cells(1).Range.Text = "Monday - Friday AM"
.Cells(2).Range.Text = "Monday - Friday PM"
.Cells(3).Range.Text = "Monday - Friday TBD"
'Continue here with the column headers
End With
Set rwNew = tblTarget.Rows.Add

For Each rw In tblSource.Rows
sReportTime = ""
sCompanyName = CleanCellText(rw.Cells(1).Range.Text)
For iCellCounter = 2 To rw.Cells.Count
sReportTime = sReportTime &
CleanCellText(rw.Cells(iCellCounter).Range.Text)
Next

Select Case sReportTime
Case "MAM"
rwNew.Cells(1).Range.Text = sCompanyName
Case "MPM"
rwNew.Cells(2).Range.Text = sCompanyName
Case "MTBD"
rwNew.Cells(3).Range.Text = sCompanyName
Case "TAM"
rwNew.Cells(4).Range.Text = sCompanyName
Case "TPM"
rwNew.Cells(5).Range.Text = sCompanyName
'Continue here with each type of "time"
Case Else
'Will only execute if there's not a match
'In this case, nothing happens
End Select
Set rwNew = Nothing
Set rwNew = tblTarget.Rows.Add
Next
End Sub

Function CleanCellText(s As String) As String
CleanCellText = Left(s, Len(s) - 2)
End Function

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail

 

[Alan in NJ]

Thank you very much Cindy.

Alan

Hi Alan,

Yeah, I'd want to automate it, too. Here's some sample code to get you
going. I
haven't typed out everything for every column, but based on the pattern,
you
should be able to complete it.

Sub ConvertTableData()
Dim tblSource As Word.Table
Dim tblTarget As Word.Table
Dim docSource As Word.Document
Dim docTarget As Word.Document
Dim rw As Word.Row
Dim rwNew As Word.Row
Dim iCellCounter As Long
Dim sCompanyName As String
Dim sReportTime As String

Set docSource = ActiveDocument
Set tblSource = docSource.Tables(1)
Set docTarget = Documents.Add
Set tblTarget = docTarget.Tables.Add(Range:=docTarget.Content,
NumRows:=1,
NumColumns:=15)
With tblTarget.Rows(1)
.Cells(1).Range.Text = "Monday - Friday AM"
.Cells(2).Range.Text = "Monday - Friday PM"
.Cells(3).Range.Text = "Monday - Friday TBD"
'Continue here with the column headers
End With
Set rwNew = tblTarget.Rows.Add

For Each rw In tblSource.Rows
sReportTime = ""
sCompanyName = CleanCellText(rw.Cells(1).Range.Text)
For iCellCounter = 2 To rw.Cells.Count
sReportTime = sReportTime &
CleanCellText(rw.Cells(iCellCounter).Range.Text)
Next

Select Case sReportTime
Case "MAM"
rwNew.Cells(1).Range.Text = sCompanyName
Case "MPM"
rwNew.Cells(2).Range.Text = sCompanyName
Case "MTBD"
rwNew.Cells(3).Range.Text = sCompanyName
Case "TAM"
rwNew.Cells(4).Range.Text = sCompanyName
Case "TPM"
rwNew.Cells(5).Range.Text = sCompanyName
'Continue here with each type of "time"
Case Else
'Will only execute if there's not a match
'In this case, nothing happens
End Select
Set rwNew = Nothing
Set rwNew = tblTarget.Rows.Add
Next
End Sub

Function CleanCellText(s As String) As String
CleanCellText = Left(s, Len(s) - 2)
End Function

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)


This reply is posted in the Newsgroup; please post any follow question or
reply
in the newsgroup and not by e-mail