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

Re: Covid and Excel VBA

I nearly forgot...

Here is a pic of the "Interface" sheet where it is all controlled from. I told you it was crude.

You will recognize the headings listed on the left this is where the script gets that info from.

Re: Covid and Excel VBA

I am not a computer buff but I can get all the latest worldwide data on the wordometer site with a couple of clicks.

Re: Covid and Excel VBA

All very clever that you know how to do that. To be honest I wouldn't know where to start and know nothing about VBA or Microsoft Excel but I could keyboard those few words and figures very quickly though. Three windows open – one each for OFF, a text program and the Worldometer's website, then when completed copy and paste the resulting text file into OFF – job done.

The next time it would be even quicker as the first text file of words and figures would be retained and the current figures from the Worldometer's website keyed in over the previous ones after highlighting them. By the way, the figure of total cases per million population in today's post is missing, it should be 440 from what I saw on the Worldometer's website just now.

Each to their own I guess.

Re: Covid and Excel VBA

Bruce I didn't realise so much was involved in your posts of the Covid virus every morning...

I find them very interesting to follow so I would like to say a big thank you for that.

Re: Covid and Excel VBA

You are quite correct about the figures, if you look at the post it was my clumsy fingers after the event when I added the comment at the bottom. Somehow the 440 got added to the 30 Critical on the line above (30440 critical is three times the total number of cases). Its a case of the computer output being stuffed up by human intervention.

Your method as described is similar to what I used to do but this is far quicker and easier being just a matter of opening the excel file, I don't need to go to a web site until I copy and paste in the OFF forum - It is possible I could automate that too but I like to read the other threads so it would be too much work for no gain.

I think you would be surprised how long the method you describe actually takes, the longest time is waiting for the table to download which takes about 15 seconds and is automatic when I open the Excel file now

Re: Covid and Excel VBA

To be honest Mags it is no work at all just a couple of button presses when I used to post it manually it took much longer. Writing the script probably took as long as preparing two or three posts because it is so basic, the preparation and testing another 15 to 20 minutes again because there is not much to go wrong, as I say it is very basic quick and dirty code.

What else is one to do in a Covid evening? and it is a fascinating record on OFF of the disease's progress

Re: Covid and Excel VBA

You raised some issues of time saving so I thought I would test this.

OK some provisos. I am using a laptop and the pad rather than the mouse which is slower and I also made mistakes though I don't think that would hav increased the time taken by more than 30secs. The program used to record this slows the laptop down. I didn't include transferring the message to OFF as that would have been the same in both cases.

Anyway this shows that my old method took about 5 minutes and is prone to mistakes whereas the automated version took 1 minute with minimal intervention from me.

Pretty boring video but there you go what else is there to do on a sunny Saturday?

Re: Covid and Excel VBA

After all the excitement generated by my original post I thought I would put up the slightly modified code used to read the downloaded table and generate the text file.

----------


Option Explicit

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

'Delete extraneous data

If Sheets(1).Range("B3").Value = "North America" Then
Sheets(1).Range("a3:s9").Delete
Sheets(1).Range("p:s").EntireColumn.Delete
End If


' 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 = Worksheets("Interface").Range("A20").Value

If Right(MyFile, 1) <> "\" Then MyFile = MyFile & "\"

RevDate = Format(Date, "yymmdd")

MyFile = MyFile & RevDate & " Covid Data.txt"

Open MyFile For Output As #1

'Start writing data to text file

'Date Title

Print #1, "[i]Covid data for " & Format(Date, "Long Date") & "[/i]"
Print #1,

'Global Data

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

'Add URL

Print #1, "https://www.worldometers.info/coronavirus/"

Close #1

Erase FinalData

Worksheets("Interface").Activate

End Sub

-----------------

Most of the changes involve the way the text file is written and now the file location is kept on the interface page rather than hard coded to make it easier to change.

The interface page now looks like this:


Exciting eh?

Re: Covid and Excel VBA

Bruce


What is VBA in Microsoft Excel.? In simple terms please