Covid and Excel VBA
I don't know if anybody is interested in how I create the messages that I put up each day about the Covid virus but it is all done by using VBA in Microsoft Excel.
First there is a quick and dirty script that downloads the data from the web site into an Excel file.
-------------
Sub GetTable()
Dim ws As Worksheet
Dim qt As QueryTable
Dim URL As String
Dim DateName As String
Dim bCheck As Boolean
URL = "https://www.worldometers.info/coronavirus/"
'create name for spreadsheet
DateName = Format(Date, "dd mmm yyyy")
'Check if sheet already exists
On Error Resume Next
bCheck = Len(Sheets(DateName).Name) > 0
On Error GoTo 0
If bCheck = True Then Exit Sub
'create a new sheet for the data
Set ws = Worksheets.Add(Before:=Sheets(1))
ws.Name = DateName
'get the data from their web site
Set qt = ws.QueryTables.Add(Connection:="URL;" & URL, Destination:=Range("A1"))
With qt
.WebFormatting = xlWebFormattingRTF
.Name = DateName
.WebSelectionType = xlAllTables
.WebTables = 1
.Refresh
End With
End Sub
-----------
The data has to be tidied up but that is just done by a quick routine that deletes some extra rows and columns.
Below is the script that find the relevent data from the downloaded data and puts it in a text file that I can copy and paste to a message. Again a very quick and dirty piece of VBA with little error checking.
The lines beginning with ' are just comments to remind me what I am doing.
-----------
Sub GetCountryData()
Dim SearchRange As Range
Dim Country As Range
Dim DataInfo As String
Dim RevDate As String
Dim FinalData(1 To 4, 1 To 4) As Variant
Dim Dim1 As Integer, Dim2 As Integer
Dim MyFile As String
' Activate the new sheet and find its length
Sheets(1).Activate
Set SearchRange = Sheets(1).Range("b1", Range("b3").End(xlDown))
'get the world data first and write into an array
Set Country = SearchRange.Find(what:="World", MatchCase:=True, lookat:=xlWhole)
FinalData(1, 1) = Country.Offset(0, 1).Value
FinalData(1, 2) = Country.Offset(0, 3).Value
'get individual country data from list in "Interface" sheet and add to array
For Dim1 = 2 To 4
DataInfo = Worksheets("Interface").Range("a1").Offset((Dim1 - 2), 0).Value
Set Country = SearchRange.Find(what:=DataInfo, MatchCase:=True, lookat:=xlWhole)
If Country Is Nothing Then Exit For
FinalData(Dim1, 1) = Country.Offset(0, 1).Value
FinalData(Dim1, 2) = Country.Offset(0, 3).Value
FinalData(Dim1, 3) = Country.Offset(0, 8).Value
FinalData(Dim1, 4) = Country.Offset(0, 9).Value
Next Dim1
'create text fle to write data to
MyFile = "C:\Users\bcl19\Documents\Office\Notepad\"
RevDate = Format(Date, "yymmdd")
MyFile = MyFile & RevDate & " Covid Data.txt"
Open MyFile For Output As #1
'Start writing data to text file
Print #1, "Global Cases " & Format(FinalData(1, 1), "#,###,##0")
Print #1, "Global Deaths " & Format(FinalData(1, 2), "#,###,##0")
Print #1,
'get data from array to write to sheet
For Dim1 = 2 To 4
Print #1, "[b]" & Worksheets("Interface").Cells(Dim1 - 1, 1).Value & "[/b]"
For Dim2 = 1 To 4
Print #1, Worksheets("Interface").Cells((Dim2 + 3), 1).Value & " " & Format(FinalData(Dim1, Dim2), "#,###,##0")
Next Dim2
Print #1,
Next Dim1
Print #1, "https://www.worldometers.info/coronavirus/"
Close #1
Erase FinalData
End Sub
------------
This creates the text file you are familiar with. in this case it is called "200717 Covid Data.txt" as determined by the code:
Global Cases 13,949,386
Global Deaths 592,690
[b]Australia[/b]
Cases 11,233
Deaths 116
Critical 32
Cases per Million 440
[b]UK[/b]
Cases 292,552
Deaths 45,119
Critical 145
Cases per Million 4,308
[b]USA[/b]
Cases 3,695,025
Deaths 141,118
Critical 16,452
Cases per Million 11,160
https://www.worldometers.info/coronavirus/
That's all folks...
It works very well and is very quick. You are welcome to copy and paste this into your version of Excel and try it though you will need to change the path names for the text file. Normally I wouldn't hard code them into the sub routine but this was knocked up very quickly. I might fiddle with it and tidy it up but then again it works OK so I might not