How to prevent the sheet from changing whenever the codes refresh

[whcmelvin]

Hi, this is urgent. how do i prevent the sheets from changing whenever the codes below runs? the code below will run every 5 seconds. but whenever it runs, it will go to EmailSheetAuto. i had tried not to select the sheet at the beginning but it does not work. Please help. I am stuck here for hours already.
I would appreciate your help very much.

Dim TimeToRun

Sub ScheduleCopyPriceOver()
    Application.ScreenUpdating = False
    TimeToRun = Now + TimeValue("00:00:05")
    Application.OnTime TimeToRun, "CopyPriceOver"
End Sub

Sub CopyPriceOver()

    Dim r As Range
    Dim n As Long
    Dim NextRow As Long
        Application.ScreenUpdating = False
    EmailSheetAuto = Sheets("Trading Platform").LoginName.Value
    Sheets(EmailSheetAuto).Select

    NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
    
    Set r = Range(Cells(2, 1), Cells(NextRow, 1))
    
    For n = 2 To r.Rows.Count
        If Sheets("Trading Platform").LoginName.Value = Sheets("Login Details").Cells(2, 17) Then
            If Sheets(EmailSheetAuto).Cells(n, 2).Value = "EUR/USD" Then

                Sheets(EmailSheetAuto).Cells(n, 9) = "hi"
                
            End If
            
        End If
    Next n

    Call ScheduleCopyPriceOver

End Sub

 

[p45cal]

try

Sub CopyPriceOver()
Dim r As Range
Dim n As Long
Dim NextRow As Long
Application.ScreenUpdating = False
EmailSheetAuto = Sheets("Trading Platform").LoginName.Value
With Sheets(EmailSheetAuto)
    NextRow = Application.WorksheetFunction.CountA(.Range("A:A")) + 1
    Set r = .Range(Cells(2, 1), .Cells(NextRow, 1))
    For n = 2 To r.Rows.Count
        If Sheets("Trading Platform").LoginName.Value = Sheets("Login Details").Cells(2, 17) Then
            If .Cells(n, 2).Value = "EUR/USD" Then
                .Cells(n, 9) = "hi"
            End If
        End If
    Next n
End With
Call ScheduleCopyPriceOver
End Sub

 

[whcmelvin]

hi, it did refresh, but it only refresh the first row when i am at other sheets. it will refresh everything when it is at the EmailSheetAuto. do you know why is it happening this way?

 

[p45cal]

Show us the code you are using now.

 

[whcmelvin]

Hi, the code i am using now is this.... the rest is still the same.

    Dim r As Range
    Dim n As Long
    Dim NextRow As Long
    Application.ScreenUpdating = False
    EmailSheetAuto = Sheets("Trading Platform").LoginName.Value
    With Sheets(EmailSheetAuto)
        NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
    
        Set r = Range(Cells(2, 1), Cells(NextRow, 1))
    
        For n = 2 To r.Rows.Count
            If Sheets("Trading Platform").LoginName.Value = Sheets("Login Details").Cells(2, 17) Then
                If Sheets(EmailSheetAuto).Cells(n, 2).Value = "EUR/USD" Then
                    If Sheets(EmailSheetAuto).Cells(n, 3).Value = "Buy" Then
                        PPandLL = 1467
                        Sheets(EmailSheetAuto).Cells(n, 10).Value = PPandLL
                    End If
        
                End If
            
            End If
        Next n
    End With

 

[p45cal]

You haven't copied properly.

Hi, the code i am using now is this.... the rest is still the same.

    Dim r As Range
    Dim n As Long
    Dim NextRow As Long
    Application.ScreenUpdating = False
    EmailSheetAuto = Sheets("Trading Platform").LoginName.Value
    With Sheets(EmailSheetAuto)
        NextRow = Application.WorksheetFunction.CountA([B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Range("A:A")) + 1
    
        Set r = [B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Range([B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Cells(2, 1), [B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Cells(NextRow, 1))
    
        For n = 2 To r.Rows.Count
            If Sheets("Trading Platform").LoginName.Value = Sheets("Login Details").Cells(2, 17) Then
                If [B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Cells(n, 2).Value = "EUR/USD" Then
                    If [B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Cells(n, 3).Value = "Buy" Then
                        PPandLL = 1467
                        [B][SIZE=6][COLOR=Red].[/COLOR][/SIZE][/B]Cells(n, 10).Value = PPandLL
                    End If
        
                End If
            
            End If
        Next n
    End With

 

[whcmelvin]

hi, sorry for not copying correctly. but it still didnt help.
My code now is

    Dim r As Range
    Dim n As Long
    Dim NextRow As Long
    Application.ScreenUpdating = False
    EmailSheetAuto = Sheets("Trading Platform").LoginName.Value
    With Sheets(EmailSheetAuto)
        NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
    
        Set r = .Range(.Cells(2, 1), .Cells(NextRow, 1))
    
        For n = 2 To r.Rows.Count
            If Sheets("Trading Platform").LoginName.Value = Sheets("Login Details").Cells(2, 17) Then
                If .Cells(n, 2).Value = "EUR/USD" Then
                    If .Cells(n, 3).Value = "Buy" Then
                        PPandLL = .Cells(n, 5) * 100000 * (Sheets("Currency").Cells(2, 2).Value - .Cells(n, 8).Value)
                        .Cells(n, 10).Value = PPandLL
                    End If

            
            
            
            
                End If
            
            End If
        Next n
    End With

 

[p45cal]

Sigh…
you're STILL not copying properly;
NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
should be
NextRow = Application.WorksheetFunction.CountA(.Range("A:A")) + 1

 

[whcmelvin]

Oh My Gosh! I am really sorry. i am too stress on my project on vba. really really sorry. but, thanks for your help. =) it worked perfectly fine now.