Re: Covid and Excel VBA
I have changed the module that creates the text file. This now refers to the previous data and creates information relating to the changes over approximately 24 hours.
The figures may vary slightly from the official figures but I try to be consistent by getting the data at about the same time each day - ie between 2.30 to 3pm Eastern time (we have just gone into daylight saving so it is an hour later than before)
As always you are welcome to try this in your own copy of Excel and modify it as you wish. It is very crude and with only minor error checking so you are welcome to improve on it. Lines starting with ' are merely comments (like REM in DOS Basic) so that in the future I can remember what each bit does.
Sub GetCountryData()
'This version checks previous sheet and adds difference data to text file
' for cases and deaths
Dim SearchRange As Range
Dim YesterRange As Range
Dim Country As Range
Dim YesterCountry As Range
Dim DataInfo As String
Dim RevDate As String
Dim FinalData(1 To 4, 1 To 6) As Variant
Dim strSpaces As String
Dim Dim1 As Integer, Dim2 As Integer
Dim MyFile As String
Dim SheetDate As Date
Application.ScreenUpdating = False
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, freeze headers, find its length and designate range
Sheets(1).Activate
'freeze headers
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.SplitColumn = 0
.SplitRow = 3
.FreezePanes = True
End With
SheetDate = Sheets(1).Name 'get date from the actual sheet as accuracy check
Set SearchRange = Sheets(1).Range("b1", Range("b3").End(xlDown))
'Active yesterday's sheet, find its length and designate range
Sheets(2).Activate
Set YesterRange = Sheets(2).Range("b1", Range("b3").End(xlDown)) 'previous days data
'get the world data first and write into an array
'Array x,1 = Cases, x,2 = Deaths, x,3 = Critical Cases, x,4 = Cases/Million
' x,5 = Cases - Yesterday's Cases, x,6 = = Deaths - Yesterday's Deaths
Set Country = SearchRange.Find(what:="World", MatchCase:=True, lookat:=xlWhole)
Set YesterCountry = YesterRange.Find(what:="World", MatchCase:=True, lookat:=xlWhole)
FinalData(1, 1) = Country.Offset(0, 1).Value
FinalData(1, 2) = Country.Offset(0, 3).Value
FinalData(1, 5) = FinalData(1, 1) - YesterCountry.Offset(0, 1).Value 'New cases in 24 hours
FinalData(1, 6) = FinalData(1, 2) - YesterCountry.Offset(0, 3).Value 'New Deaths in 24 hours
'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)
Set YesterCountry = YesterRange.Find(what:=DataInfo, MatchCase:=True, lookat:=xlWhole) 'set range for previous day
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
FinalData(Dim1, 5) = FinalData(Dim1, 1) - YesterCountry.Offset(0, 1).Value
FinalData(Dim1, 6) = FinalData(Dim1, 2) - YesterCountry.Offset(0, 3).Value
Next Dim1
'create text fle to write data to
Select Case Environ("COMPUTERNAME")
Case "BCL-LAPTOP"
MyFile = Worksheets("Interface").Range("A20").Value
Case "LEGION-PC"
MyFile = Worksheets("Interface").Range("A21").Value
End Select
If Right(MyFile, 1) <> "\" Then MyFile = MyFile & "\"
RevDate = Format(SheetDate, "yymmdd")
MyFile = MyFile & RevDate & " Covid Data.txt"
strSpaces = " " 'add seperator to text (OFF Deletes extra spaces and tabs)
Open MyFile For Output As #1
'Start writing data to text file
'Date Title using Sheet Name as Date
Print #1, "[i]Covid data for " & Format(SheetDate, "Long Date") & "[/i]"
Print #1,
'Global Data
Print #1, "Global Cases: " & Format(FinalData(1, 1), "#,###,##0")
Print #1, strSpaces & "Increase: " & Format(FinalData(1, 5), "#,###,##0")
Print #1, "Global Deaths: " & Format(FinalData(1, 2), "#,###,##0")
Print #1, strSpaces & "Increase: " & Format(FinalData(1, 6), "#,###,##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]" 'print country name
For Dim2 = 1 To 4
If Dim2 < 3 Then
Print #1, Worksheets("Interface").Cells((Dim2 + 3), 1).Value & " " & Format(FinalData(Dim1, Dim2), "#,###,##0") & strSpaces & "Change: " & Format(FinalData(Dim1, Dim2 + 4), "#,###,##0")
Else
Print #1, Worksheets("Interface").Cells((Dim2 + 3), 1).Value & " " & Format(FinalData(Dim1, Dim2), "#,###,##0")
End If
Next Dim2
Print #1,
Next Dim1
'Add URL
Print #1, "https://www.worldometers.info/coronavirus/"
'Close Text file
Close #1
'Get rid of data and array
Erase FinalData
Worksheets("Interface").Activate
Application.ScreenUpdating = True
End Sub