The best way of doing this way to use Internet Explorer to get the chemical
names and webpages. It was better to use web query to get the actual data.
Here is all the code. It was mostly copying and modifying the same code over
and over and over again.

I have an extra line of code "Exit For" to allow only the first chemical to
run. Make sure you verify what I did before removing line and running 5600
chemicals


Sub Getchemicals2()

Found = False
For Each sht In Sheets
If sht.Name = "Chemicals" Then
Found = True
Exit For
End If
Next sht
If Found = False Then
Set ChemicalSht = Sheets.Add(after:=Sheets(Sheets.Count))
ChemicalSht.Name = "Chemicals"
Else
Sheets("Chemicals").Cells.ClearContents
End If


Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URLFolder = _

"http://www.ilo.org/public/english/protection/safework/cis/products/icsc/dtasht/"
ChemicalRowCount = 1
For Letters = 0 To 25
AlphaLetter = Chr(Asc("a") + Letters)

URL = URLFolder & AlphaLetter & "_index.htm"

'get web page
IE.Navigate2 URL
Do While IE.readyState < 4
DoEvents
Loop

Do While IE.busy = True
DoEvents
Loop

H2Found = False
For Each itm In IE.document.all
If H2Found = False Then
If itm.tagname = "H2" Then
H2Found = True
End If
Else

If itm.tagname = "A" Then
If itm.innertext = "" Then Exit For

'chemical name
ChemicalSht.Range("A" & ChemicalRowCount) = itm.innertext
'webpage
ChemicalSht.Range("B" & ChemicalRowCount) = itm.href

ChemicalRowCount = ChemicalRowCount + 1
End If
End If
Next itm

Next Letters


End Sub

Sub GetData()

Found = False
For Each sht In Sheets
If sht.Name = "Temp" Then
Found = True
Exit For
End If
Next sht
If Found = False Then
Set TempSht = Sheets.Add(after:=Sheets(Sheets.Count))
TempSht.Name = "Temp"
Else
Set TempSht = Sheets("Temp")
TempSht.Cells.ClearContents
End If

Found = False
For Each sht In Sheets
If sht.Name = "Data" Then
Found = True
Exit For
End If
Next sht
If Found = False Then
Set DataSht = Sheets.Add(after:=Sheets(Sheets.Count))
DataSht.Name = "Data"
Else
Set DataSht = Sheets("Data")
DataSht.Cells.ClearContents
End If

Call MakeHeaders


Set ChemicalSht = Sheets("Chemicals")
With ChemicalSht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Chemicals = .Range("A1:A" & LastRow)

NewRowCount = 4
For Each Chemical In Chemicals
TempSht.Cells.ClearContents

With TempSht.QueryTables.Add(Connection:= _
"URL;" & Chemical.Offset(0, 1), _
Destination:=TempSht.Range("A1"))


.Name = "Temp"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Call MoveData(Chemical, NewRowCount)
NewRowCount = NewRowCount + 1
'------------------------------------- Remove Line
------------------------------------------------
Exit For
'--------------------------------------------------------------------------------------------------
Next Chemical
End With
DataSht.Columns("A:AQ").AutoFit
DataSht.Columns("AG").ColumnWidth = 50

DataSht.Rows("1:" & NewRowCount).VerticalAlignment = xlTop
End Sub



Sub MakeHeaders()

With Sheets("Data")
.Range("A1") = "Chemical Name"
.Range("B1") = "Generic Name(s)"
.Range("C1") = "CAS No"
.Range("D1") = "RTECS No"
.Range("E1") = "UN No"
.Range("F1") = "EC No"
.Range("G1") = "Alternate Names"
.Columns("G").WrapText = True
.Range("H1") = "Molecular Mass"

.Range("I1:K1").MergeCells = True
.Range("I1") = "Fire Hazard"
.Range("I1").HorizontalAlignment = xlCenter
.Range("I2") = "Acute Hazard/Symptoms"
.Range("J2") = "Prevention"
.Range("K2") = "First Aid/Fire Fighting"

.Range("L1:N1").MergeCells = True
.Range("L1") = "Explosion Hazard"
.Range("L1").HorizontalAlignment = xlCenter
.Range("L2") = "Acute Hazard/Symptoms"
.Range("M2") = "Prevention"
.Range("N2") = "First Aid/Fire Fighting"

.Range("O1:Q1").MergeCells = True
.Range("O1") = "Exposure"
.Range("O1").HorizontalAlignment = xlCenter
.Range("O2") = "Acute Hazard/Symptoms"
.Range("P2") = "Prevention"
.Range("Q2") = "First Aid/Fire Fighting"

.Range("R1:T1").MergeCells = True
.Range("R1") = "Inhalation Exposure"
.Range("R1").HorizontalAlignment = xlCenter
.Range("R2") = "Acute Hazard/Symptoms"
.Range("S2") = "Prevention"
.Range("T2") = "First Aid/Fire Fighting"

.Range("U1:W1").MergeCells = True
.Range("U1") = "Skin Exposure"
.Range("U1").HorizontalAlignment = xlCenter
.Range("U2") = "Acute Hazard/Symptoms"
.Range("V2") = "Prevention"
.Range("W2") = "First Aid/Fire Fighting"

.Range("X1:Z1").MergeCells = True
.Range("X1") = "Eyes Exposure"
.Range("X1").HorizontalAlignment = xlCenter
.Range("X2") = "Acute Hazard/Symptoms"
.Range("Y2") = "Prevention"
.Range("Z2") = "First Aid/Fire Fighting"

.Range("AA1:AC1").MergeCells = True
.Range("AA1") = "Ingestion Exposure"
.Range("AA1").HorizontalAlignment = xlCenter
.Range("AA2") = "Acute Hazard/Symptoms"
.Range("AB2") = "Prevention"
.Range("AC2") = "First Aid/Fire Fighting"

.Range("AD1") = "Spillage Disposal"
.Range("AE1") = "Packaging and Labelling"
.Columns("AE").WrapText = True
.Range("AF1") = "Emergency Response"
.Range("AG1") = "Safe Storage"
.Columns("AG").WrapText = True

.Range("AH1") = "Physical State; Appearance"
.Range("AI1") = "Routes of exposure"
.Range("AJ1") = "Chemical dangers"
.Range("AK1") = "Inhalation risk"
.Range("AL1") = "Occupational exposure limits"
.Range("AM1") = "Effects of short-term exposure"
.Range("AN1") = "Effects of long-term or repeated exposure"

.Range("AO1") = "PHYSICAL PROPERTIES"
.Range("AP1") = "ENVIRONMENTAL DATA"
.Range("AQ1") = "NOTES"

.Columns("A:AQ").AutoFit
End With
End Sub




Sub MoveData(Chemical, RowCount)

Set DataSht = Sheets("Data")
'Use ICSC: to get chemical names
With Sheets("Temp")
DataSht.Range("A" & RowCount) = Chemical

Set c = .Columns("B").Find(what:="ICSC:", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find ISCS for Chemical : " & Chemical)
Stop
Else
'Move Generic Name
DataSht.Range("B" & RowCount) = c.Offset(0, -1).Value
End If

'Use ISCS Number to find first Row of Alternate Names
FirstAlternateRow = c.Row + 2

Set c = .Columns("A").Find(what:="CAS No:", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find CAS Number for Chemical : " & Chemical)
Stop
Else
'Move Generic Name
DataSht.Range("C" & RowCount) = Trim(Mid(c.Value, InStr(c.Value, ":")
+ 1))
End If

'Use CAS Number to find Last Row of Alternate Names
LastAlternateRow = c.Row - 1
'Get Alternate Names
Alternate = ""
For TempRowCount = FirstAlternateRow To LastAlternateRow
If Alternate = "" Then
Alternate = .Range("A" & TempRowCount)
Else
Alternate = Alternate & Chr(10) & .Range("A" & TempRowCount)
End If
Next TempRowCount

'Move Alternate Name
DataSht.Range("G" & RowCount) = Alternate

Set c = .Columns("A").Find(what:="RTECS No:", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find RTECS Number for Chemical : " &
Chemical)
Stop
Else
'Move RTECS
DataSht.Range("D" & RowCount) = Trim(Mid(c.Value, InStr(c.Value, ":")
+ 1))
End If

Set c = .Columns("A").Find(what:="UN No:", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find UN Number for Chemical : " & Chemical)
Stop
Else
'Move UN No
DataSht.Range("E" & RowCount) = Trim(Mid(c.Value, InStr(c.Value, ":")
+ 1))
End If

Set c = .Columns("A").Find(what:="EC No:", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find EC Number for Chemical : " & Chemical)
Stop
Else
'Move EC No
DataSht.Range("F" & RowCount) = Trim(Mid(c.Value, InStr(c.Value, ":")
+ 1))
End If

Set c = .Columns("C").Find(what:="Molecular mass:", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Molecular for Chemical : " & Chemical)
Stop
Else
'Move molecular mass
DataSht.Range("G" & RowCount) = Trim(Mid(c.Value, InStr(c.Value, ":")
+ 1))
End If

Set c = .Columns("A").Find(what:="FIRE", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find FIRE Hazard for Chemical : " & Chemical)
Stop
Else
'Move Fire hazard
DataSht.Range("I" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("J" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("K" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="EXPLOSION", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Explosion Hazard for Chemical : " &
Chemical)
Stop
Else
'Move Explosion Hazard
DataSht.Range("L" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("M" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("N" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="EXPOSURE", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Exposure for Chemical : " & Chemical)
Stop
Else
'find 2nd occurance
Set c = .Columns("A").FindNext(after:=c)

'Move Exposure
DataSht.Range("O" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("P" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("Q" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="Inhalation", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Inhalation Exposure for Chemical : " &
Chemical)
Stop
Else
'Move Inhalation Exposure
DataSht.Range("R" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("S" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("T" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="Skin", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Skin Exposure for Chemical : " &
Chemical)
Stop
Else
'Move Skin Exposure
DataSht.Range("U" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("V" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("W" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="Eyes", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Eyes Exposure for Chemical : " &
Chemical)
Stop
Else
'Move Eyes Exposure
DataSht.Range("X" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("Y" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("Z" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="Ingestion", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Ingestion Exposure for Chemical : " &
Chemical)
Stop
Else
'Move Ingestion Exposure
DataSht.Range("AA" & RowCount) = c.Offset(0, 1).Value
DataSht.Range("AB" & RowCount) = c.Offset(0, 2).Value
DataSht.Range("AC" & RowCount) = c.Offset(0, 3).Value
End If

Set c = .Columns("A").Find(what:="SPILLAGE DISPOSAL", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find SPILLAGE DISPOSAL for Chemical : " &
Chemical)
Stop
Else
'Move SPILLAGE DISPOSAL
DataSht.Range("AD" & RowCount) = c.Offset(1, 0).Value
End If

Set c = .Columns("B").Find(what:="PACKAGING & LABELLING",
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find PACKAGING & LABELLING for Chemical : "
& Chemical)
Stop
Else
'Move PACKAGING & LABELLING
Packaging = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If Packaging = "" Then
Packaging = .Range("B" & TempRowCount)
Else
Packaging = Packaging & Chr(10) & .Range("B" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AE" & RowCount) = Packaging
End If

Set c = .Columns("A").Find(what:="EMERGENCY RESPONSE", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find EMERGENCY RESPONSE for Chemical : " &
Chemical)
Stop
Else
'Move EMERGENCY RESPONSE
DataSht.Range("AF" & RowCount) = c.Offset(1, 0).Value
End If

Set c = .Columns("B").Find(what:="SAFE STORAGE", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Safe Storage for Chemical : " &
Chemical)
Stop
Else
'Move Safe Storage
DataSht.Range("AG" & RowCount) = c.Offset(1, 0).Value
End If

Set c = .Columns("A").Find(what:="Physical State; Appearance",
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Physical State; Appearance for
Chemical : " & Chemical)
Stop
Else
'Move Physical State; Appearance
Appearance = ""
TempRowCount = c.Row + 1
Do While .Range("A" & TempRowCount) < ""
If Appearance = "" Then
Appearance = .Range("A" & TempRowCount)
Else
Appearance = Appearance & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AH" & RowCount) = Appearance
End If

Set c = .Columns("B").Find(what:="Routes of exposure", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Routes of exposure for Chemical : " &
Chemical)
Stop
Else
'Move Routes of exposure
Routes = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If Routes = "" Then
Routes = .Range("B" & TempRowCount)
Else
Routes = Routes & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AI" & RowCount) = Routes
End If

Set c = .Columns("A").Find(what:="Chemical dangers", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Chemical dangers for Chemical : " &
Chemical)
Stop
Else
'Move Chemical dangers
Dangers = ""
TempRowCount = c.Row + 1
Do While .Range("A" & TempRowCount) < ""
If Dangers = "" Then
Dangers = .Range("A" & TempRowCount)
Else
Dangers = Dangers & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AJ" & RowCount) = Dangers
End If

Set c = .Columns("B").Find(what:="Inhalation risk", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Inhalation risk for Chemical : " &
Chemical)
Stop
Else
'Move Inhalation risk
Inhalation = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If Inhalation = "" Then
Inhalation = .Range("B" & TempRowCount)
Else
Inhalation = Inhalation & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AK" & RowCount) = Inhalation
End If

Set c = .Columns("A").Find(what:="Occupational exposure limits",
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Occupational exposure limits for
Chemical : " & Chemical)
Stop
Else
'Move Occupational exposure limits
Occupational = ""
TempRowCount = c.Row + 1
Do While .Range("A" & TempRowCount) < ""
If Occupational = "" Then
Occupational = .Range("A" & TempRowCount)
Else
Occupational = Occupational & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AL" & RowCount) = Occupational
End If

Set c = .Columns("B").Find(what:="Effects of short-term exposure",
LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Effects of short-term exposure for
Chemical : " & Chemical)
Stop
Else
'Move Effects of short-term exposure
ShortTerm = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If ShortTerm = "" Then
ShortTerm = .Range("B" & TempRowCount)
Else
ShortTerm = ShortTerm & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AM" & RowCount) = ShortTerm
End If

Set c = .Columns("B").Find(what:="Effects of long-term or repeated
exposure", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find Effects of long-term or repeated
exposure for Chemical : " & Chemical)
Stop
Else
'Move Effects of long-term or repeated exposure
LongTerm = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If LongTerm = "" Then
LongTerm = .Range("B" & TempRowCount)
Else
LongTerm = LongTerm & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AN" & RowCount) = LongTerm
End If

Set c = .Columns("A").Find(what:="PHYSICAL PROPERTIES", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find PHYSICAL PROPERTIES for Chemical : " &
Chemical)
Stop
Else
'Move PHYSICAL PROPERTIES
Physical = ""
TempRowCount = c.Row + 1
Do While .Range("B" & TempRowCount) < ""
If Physical = "" Then
Physical = .Range("B" & TempRowCount)
Else
Physical = Physical & Chr(10) & .Range("A" & TempRowCount)
End If

TempRowCount = TempRowCount + 1
Loop
DataSht.Range("AO" & RowCount) = Physical
End If

Set c = .Columns("B").Find(what:="ENVIRONMENTAL DATA", LookIn:=xlValues,
lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find ENVIRONMENTAL DATA for Chemical : " &
Chemical)
Stop
Else
'Move ENVIRONMENTAL DATA
DataSht.Range("AP" & RowCount) = c.Offset(1, 0).Value
End If

Set c = .Columns("A").Find(what:="NOTES", LookIn:=xlValues, lookat:=xlPart)
If c Is Nothing Then
MsgBox ("Error - Could not find NOTES for Chemical : " & Chemical)
Stop
Else
'Move NOTES
DataSht.Range("AQ" & RowCount) = c.Offset(1, 0).Value
End If

End With


End Sub