Use of arrays and loops

O

OceanMat

I need to write a word macro that looks up a series of web pages, downloads a
series of table (one per web page) and then paste it into word and finally
formatting it.
I can create a table for each of these web pages - and it formats it OK.But
I have to do one at a time and 'rem' each web page out and run the macro for
each table needed.

However, I would like it to sequentially scroll through the web pages shown
below and automatically insert the tables one after the other, with 2 line
feeds between each table

ie.navigate "http://www.skysports.com/football/league/0,19540,11660,00.html"
ie.navigate "http://www.skysports.com/football/league/0,19540,11687,00.html"
ie.navigate "http://www.skysports.com/football/league/0,19540,11718,00.html"
ie.navigate "http://www.skysports.com/football/league/0,19540,11749,00.html"
ie.navigate "http://www.skysports.com/football/league/0,19540,11780,00.html"

I would think it could be done with arrays, but do not have enough
experience on doing this.
Can anyone please provide details on this?

Complete code for the main macro:

Option Explicit
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim tbl As HTMLTable
Dim blc As HTMLBlockElement
Dim doctbl As Table

Private Sub CommandButton1_Click()
Dim nrow As Integer
Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = False
'***** This sets the web page to access:
'Premier
' ie.navigate "http://www.skysports.com/football/league/0,19540,11660,00.html"

'Championship
' ie.navigate "http://www.skysports.com/football/league/0,19540,11687,00.html"

'League1
ie.navigate "http://www.skysports.com/football/league/0,19540,11718,00.html"

'League2
'ie.navigate "http://www.skysports.com/football/league/0,19540,11749,00.html"

'Scottish Premier
'ie.navigate "http://www.skysports.com/football/league/0,19540,11780,00.html"
Do

MsgBox "Looking up data on Skysports... Please wait.", , "Data Collector"



'***** MC - wait until internet page has completed loading
DoEvents
Loop While ie.readyState <> READYSTATE_COMPLETE


Set doc = ie.Document

'this searches for the element name - eg table id="ss-stat-sort"
Set tbl = doc.getElementById("ss-stat-sort")

'"ss-stat-sort" is the html code on this page

nrow = tbl.Rows.Length - 1

'this looks for the tag "<caption> in the html code
Set blc = tbl.all.tags("caption").Item(0)

'***** MC - insert the table title bar
'outerText = Returns or sets a String that represents the text, without any
HTML, of a DIV element
ActiveDocument.Range.InsertAfter blc.outerText



Dim myrange As Range
Set myrange = ActiveDocument.Content
myrange.Collapse direction:=wdCollapseEnd


'***** MC - this part selects for 10 columns
Set doctbl = ActiveDocument.Tables.Add(myrange, nrow, 10)

Dim i As Integer, x As Integer

'***** MC - select no of teams to show from the top - for top 10 type -11
here,
' else type -1 default
x = tbl.Rows.Length - 1

Dim col As Integer, j As Integer
For i = 2 To x
Set tr = tbl.all.tags("tr").Item(i)
col = tr.all.tags("td").Length - 2
For j = 2 To col
Set td = tr.all.tags("td").Item(j)
doctbl.Cell(i, j).Range.Text = td.outerText
Next
DoEvents

'***** MC - above code inserts the data for first row - the 'next' code
below loops through rest of the rows and repeats

Next

ActiveDocument.Tables(1).Columns(2).Select

'now look through all football team names and shorten as required

'Manchester > Man
'United > Utd
'Rovers > -
'Hotspur > -
'Wanderers > -
'Wolverhampton Wanderers > Wolves
'Athletic > -
'Birmingham City > Birmingham


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Manchester"
.Replacement.Text = "Man"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "United"
.Replacement.Text = "Utd"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rovers"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Hotspur"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wolverhampton Wanderers"
.Replacement.Text = "Wolves"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Athletic"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Birmingham City"
.Replacement.Text = "Birmingham"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Dagenham & Redbridge"
.Replacement.Text = "Dagenham & R"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham United"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham Utd"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Accrington Stanley"
.Replacement.Text = "Accrington S"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Shrewsbury Town"
.Replacement.Text = "Shrewsbury"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Macclesfield Town"
.Replacement.Text = "Macclesfield"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Mansfield Town"
.Replacement.Text = "Mansfield"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Peterborough Utd"
.Replacement.Text = "Peterborough"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Dons"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " County"
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "West Bromwich Albion"
.Replacement.Text = "WBA"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Argyle"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Queens Park Rangers"
.Replacement.Text = "QPR"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " North End"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wednesday"
.Replacement.Text = "Wed"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Inverness Caledonian Thistle"
.Replacement.Text = "Inverness"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Town"
.Replacement.Text = "T"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "and Hove Albion"
.Replacement.Text = "& H"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Nottingham Forest"
.Replacement.Text = "Notts Forest"
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Alexandra"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue

End With
Selection.Find.Execute Replace:=wdReplaceAll


'***** MC - this sets the column width for the second column (eg the team
name)
' doctbl.Columns(2).Width = 140

'***** MC - this sets the column width for the remaining columns (eg the data)
'For i = 3 To 10
'doctbl.Columns(i).Width = 30
'Next


Selection.HomeKey Unit:=wdStory



ActiveDocument.Tables(1).Columns(1).Delete



'Insert the header titles
ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range.Select
Selection.TypeText "Team"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range.Select
Selection.TypeText "Pld"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range.Select
Selection.TypeText "W"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=4).Range.Select
Selection.TypeText "D"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=5).Range.Select
Selection.TypeText "L"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=6).Range.Select
Selection.TypeText "GF"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=7).Range.Select
Selection.TypeText "GA"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=8).Range.Select
Selection.TypeText "GD"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=9).Range.Select
Selection.TypeText "Pts"

Selection.Rows(1).Select
Selection.Font.Bold = wdToggle

Selection.Tables(1).Select
Selection.Font.Size = 6


ActiveDocument.Tables(1).Columns(1).Width = 40

For i = 3 To 9
'doctbl.Columns(i).Width = 10

' ActiveDocument.Tables(1).Columns(i).Width = 5
Next

'
' This part converts table to text then sets columns

Selection.Rows.ConvertToText Separator:=wdSeparateByTabs,
NestedTables:= _
True
CommandBars("Control Toolbox").Visible = False
Selection.ParagraphFormat.TabStops(CentimetersToPoints(2.97)).Position = _
CentimetersToPoints(1.9)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(4.53)).Position = _
CentimetersToPoints(2.54)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(6.1)).Position = _
CentimetersToPoints(3.17)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(7.66)).Position = _
CentimetersToPoints(3.81)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(9.22)).Position = _
CentimetersToPoints(4.44)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(10.78)).Position
= _
CentimetersToPoints(5.08)
Selection.ParagraphFormat.TabStops(CentimetersToPoints(12.35)).Position
= _
CentimetersToPoints(5.71)
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle


Selection.Find.ClearFormatting

' This part looks for the title and then neatens it up

Selection.Find.ClearFormatting
With Selection.Find
.Text = "Team"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.EndKey Unit:=wdLine
MsgBox "End of macro..."

End Sub
 
D

David Sisson

Option Explicit

Private Sub CommandButton1_Click()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim tbl As HTMLTable
Dim blc As HTMLBlockElement
Dim doctbl As Table
Dim nrow As Integer

Dim A As Integer
Dim NavPages As Variant
Dim Temp$

Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = False
'***** This sets the web page to access:
'Premier
Temp$ = "http://www.skysports.com/football/league/
0,19540,11660,00.html;" & _
"http://www.skysports.com/football/league/0,19540,11687,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11718,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11749,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11780,00.html"
NavPages = Split(Temp$, ";")

For A = 0 To UBound(NavPages)

ie.Navigate NavPages(A)

' ie.navigate "http://www.skysports.com/football/league/
0,19540,11660,00.html"

'Championship
' ie.navigate "http://www.skysports.com/football/league/
0,19540,11687,00.html"

'League1
' ie.Navigate "http://www.skysports.com/football/league/
0,19540,11718,00.html"

'League2
'ie.navigate "http://www.skysports.com/football/league/
0,19540,11749,00.html"

'Scottish Premier
'ie.navigate "http://www.skysports.com/football/league/
0,19540,11780,00.html"
Do

MsgBox "Looking up data on Skysports...", , "Collecting Data"

'***** MC - wait until internet page has completed loading
DoEvents
Loop While ie.readyState <> READYSTATE_COMPLETE

Set doc = ie.Document

'this searches for the element name - eg table id="ss-stat-sort"
Set tbl = doc.getElementById("ss-stat-sort")

'"ss-stat-sort" is the html code on this page

nrow = tbl.Rows.Length - 1

'this looks for the tag "<caption> in the html code
Set blc = tbl.all.tags("caption").Item(0)

'***** MC - insert the table title bar
'outerText = Returns or sets a String that represents the text,
'without any HTML, of a DIV element
ActiveDocument.Range.InsertAfter blc.outerText

Dim myrange As Range
Set myrange = ActiveDocument.Content
myrange.Collapse direction:=wdCollapseEnd

'***** MC - this part selects for 10 columns
Set doctbl = ActiveDocument.Tables.Add(myrange, nrow, 10)

Dim i As Integer, x As Integer

'***** MC - select no of teams to show from the top - for top 10 type
-11 here,
' else type -1 default
x = tbl.Rows.Length - 1

Dim col As Integer, j As Integer
For i = 2 To x
Set tr = tbl.all.tags("tr").Item(i)
col = tr.all.tags("td").Length - 2
For j = 2 To col
Set td = tr.all.tags("td").Item(j)
doctbl.Cell(i, j).Range.Text = td.outerText
Next
DoEvents

'***** MC - above code inserts the data for first row - the 'next'
code
'below loops through rest of the rows and repeats

Next

ActiveDocument.Tables(1).Columns(2).Select

'now look through all football team names and shorten as required

'Manchester > Man
'United > Utd
'Rovers > -
'Hotspur > -
'Wanderers > -
'Wolverhampton Wanderers > Wolves
'Athletic > -
'Birmingham City > Birmingham


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Manchester"
.Replacement.Text = "Man"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "United"
.Replacement.Text = "Utd"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rovers"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Hotspur"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wolverhampton Wanderers"
.Replacement.Text = "Wolves"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Athletic"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Birmingham City"
.Replacement.Text = "Birmingham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Dagenham & Redbridge"
.Replacement.Text = "Dagenham & R"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham United"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham Utd"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Accrington Stanley"
.Replacement.Text = "Accrington S"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Shrewsbury Town"
.Replacement.Text = "Shrewsbury"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Macclesfield Town"
.Replacement.Text = "Macclesfield"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Mansfield Town"
.Replacement.Text = "Mansfield"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Peterborough Utd"
.Replacement.Text = "Peterborough"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Dons"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " County"
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "West Bromwich Albion"
.Replacement.Text = "WBA"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Argyle"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Queens Park Rangers"
.Replacement.Text = "QPR"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " North End"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wednesday"
.Replacement.Text = "Wed"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Inverness Caledonian Thistle"
.Replacement.Text = "Inverness"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Town"
.Replacement.Text = "T"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "and Hove Albion"
.Replacement.Text = "& H"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Nottingham Forest"
.Replacement.Text = "Notts Forest"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Alexandra"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


'***** MC - this sets the column width for the second column (eg the
team name)
' doctbl.Columns(2).Width = 140


'***** MC - this sets the column width for the remaining columns (eg
the data)
'For i = 3 To 10
'doctbl.Columns(i).Width = 30
'Next


Selection.HomeKey Unit:=wdStory


ActiveDocument.Tables(1).Columns(1).Delete


'Insert the header titles
ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range.Select
Selection.TypeText "Team"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range.Select
Selection.TypeText "Pld"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range.Select
Selection.TypeText "W"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=4).Range.Select
Selection.TypeText "D"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=5).Range.Select
Selection.TypeText "L"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=6).Range.Select
Selection.TypeText "GF"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=7).Range.Select
Selection.TypeText "GA"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=8).Range.Select
Selection.TypeText "GD"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=9).Range.Select
Selection.TypeText "Pts"


Selection.Rows(1).Select
Selection.Font.Bold = wdToggle


Selection.Tables(1).Select
Selection.Font.Size = 6


ActiveDocument.Tables(1).Columns(1).Width = 40


For i = 3 To 9
'doctbl.Columns(i).Width = 10


' ActiveDocument.Tables(1).Columns(i).Width = 5
Next


'
' This part converts table to text then sets columns


Selection.Rows.ConvertToText Separator:=wdSeparateByTabs,
NestedTables:= _
True
CommandBars("Control Toolbox").Visible = False

Selection.ParagraphFormat.TabStops(CentimetersToPoints(2.97)).Position
= _
CentimetersToPoints(1.9)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(4.53)).Position
= _
CentimetersToPoints(2.54)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(6.1)).Position
= _
CentimetersToPoints(3.17)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(7.66)).Position
= _
CentimetersToPoints(3.81)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(9.22)).Position
= _
CentimetersToPoints(4.44)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(10.78)).Position
= _
CentimetersToPoints(5.08)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(12.35)).Position
= _
CentimetersToPoints(5.71)
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle


Selection.Find.ClearFormatting


' This part looks for the title and then neatens it up


Selection.Find.ClearFormatting
With Selection.Find
.Text = "Team"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.EndKey Unit:=wdLine


With ActiveDocument.Range
.Collapse wdCollapseEnd
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
End With


Next A

MsgBox "End of macro..."
End Sub
 
D

David Sisson

Here's a range version.

Sub Main3()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim tbl As HTMLTable
Dim blc As HTMLBlockElement
Dim doctbl As Table
Dim nrow As Integer
Dim i As Integer, x As Integer
Dim Rng As Range
Dim myrange As Range
Dim A As Integer
Dim NavPages As Variant
Dim WebSiteAdd As String
Dim TeamNames As String
Dim TeamArray As Variant
Dim TS As TabStop

Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = False
'***** This sets the web page to access:
'Premier

WebSiteAdd = "http://www.skysports.com/football/league/
0,19540,11660,00.html;" & _
"http://www.skysports.com/football/league/0,19540,11687,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11718,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11749,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11780,00.html"
NavPages = Split(WebSiteAdd, ";")

For A = 0 To UBound(NavPages)

ie.Navigate NavPages(A)

'Premier "http://www.skysports.com/football/league/
0,19540,11660,00.html"
'Championship "http://www.skysports.com/football/league/
0,19540,11687,00.html"
'League1 "http://www.skysports.com/football/league/
0,19540,11718,00.html"
'League2 "http://www.skysports.com/football/league/
0,19540,11749,00.html"
'Scottish Premier "http://www.skysports.com/football/league/
0,19540,11780,00.html"

'Give user some feedback.
Application.StatusBar = "Fetching website " & A + 1
Do
'MsgBox "Looking up data on Skysports...", , "Collecting Data"
'***** MC - wait until internet page has completed loading
DoEvents
Loop While ie.readyState <> READYSTATE_COMPLETE

Set doc = ie.Document

'this searches for the element name - eg table id="ss-stat-sort"
Set tbl = doc.getElementById("ss-stat-sort")

'"ss-stat-sort" is the html code on this page
nrow = tbl.Rows.Length - 1

'this looks for the tag "<caption> in the html code
Set blc = tbl.all.tags("caption").Item(0)

'***** MC - insert the table title bar
'outerText = Returns or sets a String that represents the text,
'without any HTML, of a DIV element
Set Rng = ActiveDocument.Range
Rng.InsertAfter blc.outerText

'***** MC - this part selects for 10 columns
'Collapse rng to end of document
'Set Rng = ActiveDocument.Range
Rng.Collapse direction:=wdCollapseEnd
'Add table
Set doctbl = ActiveDocument.Tables.Add(Rng, nrow, 10)

'***** MC - select no of teams to show from the top - for top 10 type
-11 here,
' else type -1 default
x = tbl.Rows.Length - 1

Dim col As Integer, j As Integer
For i = 2 To x
Set tr = tbl.all.tags("tr").Item(i)
col = tr.all.tags("td").Length - 2
For j = 2 To col
Set td = tr.all.tags("td").Item(j)
doctbl.Cell(i, j).Range.Text = td.outerText
Next
DoEvents

'***** MC - above code inserts the data for first row -
'the 'next' code below loops through rest of the rows and repeats

Next

'ActiveDocument.Tables(1).Columns(1).Delete
Application.StatusBar = "Converting table of " & blc.outerText

'Insert the header titles
With ActiveDocument.Tables(1)
.Columns(1).Delete
.Cell(Row:=1, Column:=1).Range.Text = "Team"
.Cell(Row:=1, Column:=2).Range.Text = "Pld"
.Cell(Row:=1, Column:=3).Range.Text = "W"
.Cell(Row:=1, Column:=4).Range.Text = "D"
.Cell(Row:=1, Column:=5).Range.Text = "L"
.Cell(Row:=1, Column:=6).Range.Text = "GF"
.Cell(Row:=1, Column:=7).Range.Text = "GA"
.Cell(Row:=1, Column:=8).Range.Text = "GD"
.Cell(Row:=1, Column:=9).Range.Text = "Pts"
'Change the whole table to 6pt
.Range.Font.Size = 6
'Change the header row to 8pt
.Rows(1).Range.Font.Size = 8
.Rows(1).Range.Font.Bold = True
'Convert table to text
.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
End With

With ActiveDocument.Range
.Collapse wdCollapseEnd
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
End With

'This is the end of the loop that collects all the data and inserts
the table.
Next A

'Now let's clean up the table
'Look through all football team names and shorten as required
'Manchester > Man
'United > Utd
'Rovers > -
'Hotspur > -
'Wanderers > -
'Wolverhampton Wanderers > Wolves
'Athletic > -
'Birmingham City > Birmingham
'Wycombe Wanderers - Wycombe

'First Name is the searched string, the second is the replacement.
'If there are two commas, then the replacement string is ""
TeamNames$ = "Manchester,Man,Wolverhampton Wanderers,Wolves," & _
"Birmingham City,Birmingham,Wycombe Wanderers,Wycombe," & _
"Dagenham & Redbridge,Dagenham & R,Rotherham United,Rotherham," &
_
"Accrington Stanley,Accrington S,Shrewsbury Town,Shrewsbury," & _
"Macclesfield Town,Macclesfield,Mansfield Town,Mansfield," & _
"Peterborough United,Peterborough, Dons,,Country,C," & _
"West Bromwich Albion,WBA, Argyle,,Queens Park Rangers,QPR," & _
" North End,,Wednesday,Wed,Inverness Caledonian
Thistle,Inverness," & _
"and Hove Albion,H,Nottingham Forest,Notts Forest," & _
"West Bromwich Albion,W.Brom.Albion,Town,T," & _
"Rovers,,HotSpur,,Wanderers,,Athletic,,United,Utd, Alexandra,"

'Replace the team names from list above.
TeamArray = Split(TeamNames$, ",")
For A = 0 To UBound(TeamArray) Step 2
Set Rng = ActiveDocument.Range
Rng.Find.Execute findText:=TeamArray(A), _
replacewith:=TeamArray(A + 1), _
Replace:=wdReplaceAll
Next A

'This part sets columns.
With ActiveDocument.Range.ParagraphFormat.TabStops
.ClearAll
.Add Position:=CentimetersToPoints(1.9),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(2.54),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(3.17),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(3.81),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(4.44),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(5.08),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(5.71),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(6.35),
Alignment:=wdAlignTabRight
End With

Application.StatusBar = ""

End Sub
 
O

OceanMat

Hi David
Many thanks for this help.
The first one you sent works a treat !
I will test the other one you sent.
I have a query with the 'getelementbyID' - which I think identifies the
table itself ?
What happens if you do not have a table clearly defined like this one.

I would also like to go to another website -
http://www.live-football-scores.co.uk/scottish-division1-table.php
http://www.live-football-scores.co.uk/scottish-division2-table.php
http://www.live-football-scores.co.uk/scottish-division3-table.php
to collect the Scottish tables (not covered on the Sky website)
I cannot see any reference to these tables.
What would you suggest ?

Any help would be very much appreciated - thanks for suggestions so far !
Mat
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Loop until end 1
Select Text to End of Footnote 9
Word macro that can call cells out of Excel for a find and replace 0
CleanUpPastedText() 1
How do I combine 2 similar macros into one? 4
Spaces after 1 incorporate footnote 5
count a string within a selected text 1

Top