How to make this ping test with timer more efficient?

Question

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_Open"
End Sub

Sub 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 Countup
End Sub

Public 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 = strData
End 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 = Nothing
End Function

Sub 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
    Loop
Set applicationobject = Nothing
End Sub


Function 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 With
End Function
Sub 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)).Value
End Sub

Is there another way (or better way) to do the countdown timer?

Answer 1

Using Application.OnTime is a very neat way of implementing your timer, but I have a hard time figuring out how "pings servers every 15 mins or so" translates to Now + TimeValue("00:00:01"). Note that since VBA is single-threaded, OnTime doesn't mean your code will run at that specific time, rather that when Excel isn't busy doing something else, it will queue your method for synchronous execution, like any other event handler code.

That said, your naming and access modifiers lack consistency (I guess that's what you meant with "duct-taped"?).

Observations

• You're using ListObject.ListRows.Count, but you're puzzling your way into adding a new row - why aren't you using ListObject.ListRows.Add() which returns the added row?
• In sPing function (awful name), I would refactor this ElseIf construct into some Private Function GetPingResult(StatusCode As Long) As String, and assign the function's return value once; also you made the default value "Alive" - if there's an error code you haven't accounted for, your function returns "Alive" which is possibly wrong.

Nitpicks

• This is VBA - stick to PascalCasing for all identifiers. It will make your code read consistently with the language itself.
• The default access modifier for Sub and Function is Public - thus, either specify it or leave it out, but don't do both. If the unspecified ones are supposed to be Private, be explicit about it.
• The language's convention for underscores in procedure names, is only for methods that implement interface methods (e.g. event handlers). Avoid it.
• Worse than Hungarian notation (strTableName As String), is inconsistent Hungarian notation, especially in the same method signature (why isn't it iCol As Integer then?). Avoid it (Hungarian notation, that is!).

I know this is an incomplete review, but I think you have enough meat here anyway.