Copy data to other sheet while macro is running in one sheet - excel

Question

I am writing a code for ping tester.
In sheet one it keeps on pinging devices continuously and displays the ping time in column B. When any device becomes unreachable it shows the last ping time and duration of unreachability in next column. But when that device becomes reachable it sends the duration of reachability (report) to next sheet and start showing that device reachable.
I want to open the report sheet while macro is running in sheet1.
If I'm using select (as in code) it forces me to sheet1 but without this if I open sheeet2 the pinging time started typing in sheet2.
Sub Do_ping()
With ActiveWorkbook.Worksheets(1)
Worksheets("sheet1").Select
row = 2
Do
If .Cells(row, 1) <> "" Then
If IsConnectible(.Cells(row, 1), 2, 100) = True Then
Worksheets("sheet1").Select
If Cells(row, 3).Value = nul Then
Cells(row, 1).Interior.Color = RGB(0, 255, 0)
Cells(row, 1).Font.FontStyle = "bold"
Cells(row, 1).Font.Size = 14
Cells(row, 2).Interior.Color = RGB(0, 255, 0)
Cells(row, 2).Value = Time
Else
Worksheets("sheet1").Select
Cells(row, 1).copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Cells(row, 2).copy Sheets("sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Cells(row, 5).copy Sheets("sheet2").Range("c" & Rows.Count).End(xlUp).Offset(1, 0)
Cells(row, 1).Interior.Color = RGB(0, 255, 0)
Cells(row, 1).Font.FontStyle = "bold"
Cells(row, 1).Font.Size = 14
Cells(row, 2).Interior.Color = RGB(0, 255, 0)
Cells(row, 2).Value = Time
Cells(row, 5).ClearContents
End If
'Call siren
Else:
'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now())
'Cells(Row, 1).Interior.Color = RGB(255, 0, 0)
Worksheets("sheet1").Select
Cells(row, 3).Value = DateDiff("d", Cells(row, 2), Now())
'Time Difference. First set the format in cell.
Cells(row, 4).NumberFormat = "hh:mm:ss"
'/calculate and update
Cells(row, 4).Value2 = Now() - Cells(row, 2)
Cells(row, 5).Value = Hour(Cells(row, 4).Value2) * 3600 + Minute(Cells(row, 4).Value2) * 60 + Second(Cells(row, 4).Value2)
If Cells(row, 5).Value > 120 Then
Worksheets("sheet1").Select
Cells(row, 1).Interior.ColorIndex = 3
Cells(row, 2).Interior.ColorIndex = 3
Cells(row, 3).Interior.ColorIndex = 3
Cells(row, 4).Interior.ColorIndex = 3
Else
Worksheets("sheet1").Select
Cells(row, 1).Interior.ColorIndex = 40
Cells(row, 2).Interior.ColorIndex = 40
Cells(row, 3).Interior.ColorIndex = 40
Cells(row, 4).Interior.ColorIndex = 40
End If
End If
End If
row = row + 1
Loop Until .Cells(row, 1) = ""
End With
End Sub

Answer 1

You should get rid of Select in your code, and make better use of With blocks.
Assuming the first sheet in your workbook is "Sheet1", the following code is a refactored version of your code, getting rid of the Select statements.
Sub Do_ping()
With Worksheets("Sheet1")
row = 2
Do
If .Cells(row, 1) <> "" Then
If IsConnectible(.Cells(row, 1), 2, 100) = True Then
If .Cells(row, 3).Value = nul Then ' has the variable "nul" been defined?
.Cells(row, 1).Interior.Color = RGB(0, 255, 0)
.Cells(row, 1).Font.FontStyle = "bold"
.Cells(row, 1).Font.Size = 14
.Cells(row, 2).Interior.Color = RGB(0, 255, 0)
.Cells(row, 2).Value = Time
Else
.Cells(row, 1).copy Sheets("sheet2").Range("A" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
.Cells(row, 2).copy Sheets("sheet2").Range("B" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
.Cells(row, 5).copy Sheets("sheet2").Range("c" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
.Cells(row, 1).Interior.Color = RGB(0, 255, 0)
.Cells(row, 1).Font.FontStyle = "bold"
.Cells(row, 1).Font.Size = 14
.Cells(row, 2).Interior.Color = RGB(0, 255, 0)
.Cells(row, 2).Value = Time
.Cells(row, 5).ClearContents
End If
'Call siren
Else
'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now())
'Cells(Row, 1).Interior.Color = RGB(255, 0, 0)
.Cells(row, 3).Value = DateDiff("d", .Cells(row, 2), Now())
'Time Difference. First set the format in cell.
.Cells(row, 4).NumberFormat = "hh:mm:ss"
'/calculate and update
.Cells(row, 4).Value2 = Now() - .Cells(row, 2)
.Cells(row, 5).Value = Hour(.Cells(row, 4).Value2) * 3600 + Minute(.Cells(row, 4).Value2) * 60 + Second(.Cells(row, 4).Value2)
If .Cells(row, 5).Value > 120 Then
.Cells(row, 1).Interior.ColorIndex = 3
.Cells(row, 2).Interior.ColorIndex = 3
.Cells(row, 3).Interior.ColorIndex = 3
.Cells(row, 4).Interior.ColorIndex = 3
Else
.Cells(row, 1).Interior.ColorIndex = 40
.Cells(row, 2).Interior.ColorIndex = 40
.Cells(row, 3).Interior.ColorIndex = 40
.Cells(row, 4).Interior.ColorIndex = 40
End If
End If
End If
row = row + 1
Loop Until .Cells(row, 1) = ""
End With
End Sub
Note: I would strongly recommend that you include Option Explicit as the first line of all your code modules - I suspect that your variable nul should be Null, and the use of Option Explicit would highlight that type of error.

Answer 2

I changed the code and its working
Sub Do_ping()
With Worksheets("Sheet1")
row = 2
Do
If .Cells(row, 1) <> "" Then
If IsConnectible(.Cells(row, 1), 2, 100) = True Then
'Worksheets("sheet1").Select
If Cells(row, 3).Value = nul Then
Sheets("sheet1").Cells(row, 1).Interior.Color = RGB(0, 255, 0)
Sheets("sheet1").Cells(row, 1).Font.FontStyle = "bold"
Sheets("sheet1").Cells(row, 1).Font.Size = 14
Sheets("sheet1").Cells(row, 2).Interior.Color = RGB(0, 255, 0)
Sheets("sheet1").Cells(row, 2).Value = Time
Else
'Worksheets("sheet1").Select
Sheets("sheet1").Cells(row, 1).copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("sheet1").Cells(row, 2).copy Sheets("sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("sheet1").Cells(row, 5).copy Sheets("sheet2").Range("c" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("sheet1").Cells(row, 1).Interior.Color = RGB(0, 255, 0)
Sheets("sheet1").Cells(row, 1).Font.FontStyle = "bold"
Sheets("sheet1").Cells(row, 1).Font.Size = 14
Sheets("sheet1").Cells(row, 2).Interior.Color = RGB(0, 255, 0)
Sheets("sheet1").Cells(row, 2).Value = Time
Sheets("sheet1").Cells(row, 5).ClearContents
End If
'Call siren
Else:
'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now())
'Cells(Row, 1).Interior.Color = RGB(255, 0, 0)
'Worksheets("sheet1").Select
Sheets("sheet1").Cells(row, 3).Value = DateDiff("d", Cells(row, 2), Now())
'Time Difference. First set the format in cell.
Sheets("sheet1").Cells(row, 4).NumberFormat = "hh:mm:ss"
'/calculate and update
Sheets("sheet1").Cells(row, 4).Value2 = Now() - Cells(row, 2)
Sheets("sheet1").Cells(row, 5).Value = Hour(Cells(row, 4).Value2) * 3600 + Minute(Cells(row, 4).Value2) * 60 + Second(Cells(row, 4).Value2)
If Cells(row, 5).Value > 120 Then
'Worksheets("sheet1").Select
Sheets("sheet1").Cells(row, 1).Interior.ColorIndex = 3
Sheets("sheet1").Cells(row, 2).Interior.ColorIndex = 3
Sheets("sheet1").Cells(row, 3).Interior.ColorIndex = 3
Sheets("sheet1").Cells(row, 4).Interior.ColorIndex = 3
Else
'Worksheets("sheet1").Select
Sheets("sheet1").Cells(row, 1).Interior.ColorIndex = 40
Sheets("sheet1").Cells(row, 2).Interior.ColorIndex = 40
Sheets("sheet1").Cells(row, 3).Interior.ColorIndex = 40
Sheets("sheet1").Cells(row, 4).Interior.ColorIndex = 40
End If
End If
End If
row = row + 1
Loop Until .Cells(row, 1) = ""
End With
End Sub
Function IsConnectible(sHost, iPings, iTO)
' Returns True or False based on the output from ping.exe
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used
Dim nRes
If iPings = "" Then iPings = 1 ' default number of pings
If iTO = "" Then iTO = 550 ' default timeout per ping
With CreateObject("WScript.Shell")
nRes = .Run("%comspec% /c ping.exe -n " & iPings & " -w " & iTO _
& " " & sHost & " | find ""TTL="" > nul 2>&1", 0, True)
End With
IsConnectible = (nRes = 0)
End Function