I wrote a small ducktaped VBA script which pings servers every 15 mins or so.  If a server's status is anything other than Alive, the server and timestamp is written to another worksheet called Log. Sub Countup()    Dim CountDown As Date    CountDown = Now + TimeValue(00:00:01)    Application.OnTime CountDown, Auto_OpenEnd SubSub Auto_Open()    Dim count As Range    Set count = Worksheets(Servers).Range(A1:A1)    count.Value = count.Value - TimeSerial(0, 0, 1)    If count <= 0 Then        count = Worksheets(Servers).Range(C1:C1)        Call GetComputerToPing        Call Countup        Exit Sub    End If    Call CountupEnd SubPublic Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal Col As Integer)    Dim lLastRow As Long    Dim iHeader As Integer    With ActiveSheet.ListObjects(strTableName)        'find the last row of the list        lLastRow = ActiveSheet.ListObjects(strTableName).ListRows.count        'shift from an extra row if list has header        If .Sort.Header = xlYes Then            iHeader = 1        Else            iHeader = 0        End If    End With    'add the data a row after the end of the list    ActiveSheet.Cells(lLastRow + 1 + iHeader, Col).Value = strDataEnd Sub'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.'Set these in Tools - References in VB Editor.Function sPing(sHost) As String    On Error Resume Next    sHost = Trim(sHost)    Dim ipaddress As String    Dim computername As String    Dim Model As String    Dim memory As Long    Dim oPing As Object, oRetStatus As Object    Set oPing = GetObject(winmgmts:{impersonationLevel=impersonate})    Set oPing = oPing.execquery(select * from win32_pingstatus where address =' & sHost & ')    For Each oRetStatus In oPing        If IsNull(oRetStatus.statuscode) Then            sPing = Dead        ElseIf oRetStatus.statuscode = 11010 Then            sPing = Request Timed Out        ElseIf oRetStatus.statuscode = 11013 Then            sPing = Destination Host Unreachable        Else            sPing = Alive        End If    Next    Set oPing = Nothing    Set oRetStatus = NothingEnd FunctionSub GetComputerToPing()    Application.DisplayAlerts = False    'On Error Resume Next    Dim applicationobject As Object    Dim i As Integer    i = 3 'row to start checking servers from    Do Until Cells(i, 1) =         'If Cells(i, 1) <>  Then            'If Cells(i, 2) = Request Timed Out Or Cells(i, 2) =  Or Cells(i, 2) = Dead Then                Cells(i, 2) = sPing(Cells(i, 1))                Cells(i, 3) = Now()                'log it to Log                If Cells(i, 2).Value <> Alive Then                    Call copytest(i)                End If                    'End If        'End If        i = i + 1    LoopSet applicationobject = NothingEnd SubFunction findlast_Row() As Long    Dim ws As Worksheet    Set ws = ThisWorkbook.Sheets(Log)    With ws        findlast_Row = .Range(A & .Rows.count).End(xlUp).Row    End WithEnd FunctionSub copytest(ByVal intRow As Integer)    'screens for last row in log sheet    iLastRow = findlast_Row() + 1    Worksheets(Log).Range(A & CStr(iLastRow) & :E & CStr(iLastRow)).Value = Worksheets(Servers).Range(A & CStr(intRow) & :E & CStr(intRow)).ValueEnd SubIs there another way (or better way) to do the countdown timer?
How to make this ping test with timer more efficient?
optimization;vba;timer;excel