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

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

Do you want just to have Sheet2 open while macro is running in another worksheet? Or do you want to be able to perform some 'manual' actions in Sheet2 while macro runs in Sheet1? — Rufus, Jan 07 '17 at 20:27
@Rufus I want to toggle between sheet1 and 2.sheet2 is like unreachability report of devices.it will show the details of unreachability — DK JOSHI, Jan 07 '17 at 20:49
I highly recommend reading through [How at avoid using `.Select`\`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) and applying that as best you can. — BruceWayne, Jan 07 '17 at 21:11
Is `Worksheets("Sheet1")` the same sheet as `ActiveWorkbook.Worksheets(1)`? Or is that `Worksheets("Sheet2")? Or do the users sometimes change the order of the sheets? — YowE3K, Jan 07 '17 at 21:24

score 0 · Answer 1 · answered Jan 07 '17 at 21:29

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.

score 0 · Answer 2 · answered Jan 08 '17 at 06:44

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

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

2 Answers2