VBA Code Screen Flash

[excelbytes]

Below is VBA code that works exactly as I need it to. The button to launch the code is located on a worksheet called "DASHBOARD". The values are inserted on a worksheet called "ACTIVITIES". When the user clicks on the button, the screen flashes from the "DASHBOARD" worksheet to the "ACTIVITIES" worksheet and back. I would like to eliminate that, and have the screen just remain on the "DASHBOARD" worksheet.

I know the code is not the cleanest, I am just learning VBA. I am guessing there is a way to activate the code without the need to go to the other worksheet. Can you suggest any modifications? Thanks so much.

Sub Phone1()
'
' Enter 1 for Phone Selection
'
Dim rStart As Range

    If IsEmpty(Sheets("ACTIVITIES").Range("A2")) = True Then
        Sheets("ACTIVITIES").Select
        Range("A2").Select
        ActiveCell = Sheets("Data").Range("B1")
        ActiveCell.Offset(0, 1) = Sheets("Data").Range("D1")
    End If
    If Application.Sum(Range("E2:H2")) = 0 Then
    Range("B2").Offset(0, 4).Value = 1
    Else
    Set rStart = Sheets("ACTIVITIES").Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(0, 9)
    If Application.Sum(rStart.Resize(, 32).Value) = 0 Then
    Application.Goto Sheet1.Range("A1")
    MsgBox "Select Activity for last record"
    Else
    Sheets("ACTIVITIES").Select
    Range("C1").Select
   
    Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(0, -4).Select
    If ActiveCell = "" Then
    ActiveCell = Sheets("Data").Range("B1")
    ActiveCell.Offset(0, 1) = Sheets("Data").Range("D1")
 
   End If
   End If
   End If
   Sheets("DASHBOARD").Select
   Range("A1").Select
   End Sub

 

[JLGWhiz]

See if this stops the flicker and flash.

Sub Phone1()
'
' Enter 1 for Phone Selection
'
Dim rStart As Range
With Sheets("Activities")
    If .Range("A2") = "" Then
        .Range("A2") = Sheets("Data").Range("B1")
        .Range("B2") = Sheets("Data").Range("D1")
    End If
    If Application.Sum(.Range("E2:H2")) = 0 Then
        .Range("F2").Value = 1
    Else
        Set rStart = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(0, 9)
        If Application.Sum(rStart.Resize(, 32).Value) = 0 Then
            Application.Goto Sheet1.Range("A1")
            MsgBox "Select Activity for last record"
        Else
            .Range("C1").Select
            .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2).Select
            ActiveCell.Value = 1
            ActiveCell.Offset(0, -4).Select
                If ActiveCell = "" Then
                    ActiveCell = Sheets("Data").Range("B1").Value
                    ActiveCell.Offset(0, 1) = Sheets("Data").Range("D1")
                End If
       End If
    End If
End With
Sheets("DASHBOARD").Select
Range("A1").Select
End Sub

I am not sure what you mean by the following:

I am guessing there is a way to activate the code without the need to go to the other worksheet.

If the code is in a public module (any of the numbered modules that the user inserts and not a sheet, workbook or userform module), then it can be accessed by pressing Alt + F8 to display the macro dialog box and run the code by clicking on the macro name them click 'Run'. You can also attach the macro to a Form Controls button on the worksheet and use the button to run the code. Again the code would need to be in a public code module..

 

[excelbytes]

What I meant with my comment was that I was sure there was a way to have the code insert the values in a worksheet that was not what the user was looking at without having it visibly go to that worksheet then come back.

I see the general concept - start the section for the other worksheet with "With Sheets("sheet name") and make sure you end with "End With". Also insert a period before Range or Columns.

Now when I run the code here is what is happening:

- if the worksheet is clean (Range("A2") = ""), that works
- for the second if - if that range = 0 then the message box appears properly
- when it passes the first two IF statements, and goes to Else .Range("C1").Select, it generates a 1004 error - Select method of Range class failed.

Can you help solving this?

 

[JLGWhiz]

Oops! Missed the ActiveCell.Select. try this mod.

Sub Phone1rev2()'
' Enter 1 for Phone Selection
Dim rStart As Range
With Sheets("Activities")
    If .Range("A2") = "" Then
        .Range("A2") = Sheets("Data").Range("B1")
        .Range("B2") = Sheets("Data").Range("D1")
    End If
    If Application.Sum(.Range("E2:H2")) = 0 Then
        .Range("F2").Value = 1
    Else
        Set rStart = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(0, 9)
        If Application.Sum(rStart.Resize(, 32).Value) = 0 Then
            Application.Goto Sheet1.Range("A1")
            MsgBox "Select Activity for last record"
        Else
            .Range("C1").Select
            .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2).Select
            ActiveCell.Value = 1
                If ActiveCell.Offset(, -4) = "" Then
                    ActiveCell = Sheets("Data").Range("B1").Value
                    ActiveCell.Offset(0, 1) = Sheets("Data").Range("D1")
                End If
       End If
    End If
End With
Sheets("DASHBOARD").Select
Range("A1").Select
End Sub

 

[pjmorris]

Try adding Application.ScreeenUpdating=false at the start of the procedure and Application.Screenupdating=true at the end.

If you want to be more secure then add at the start:

On Error Resume ResetScreen
Application.Screenupdating=false

and at the end:

ResetScreen:
Application.Screenupdating=true

HTH

 

[excelbytes]

JLGWhiz: I still get the same error at the same spot
pjmorris: I get a Compile error: Syntax error at "On Error Resume ResetScreen"

 

[pjmorris]

Apologies, my mistake for not checking syntax should be:

Sub test()
On Error GoTo Resetscreen
Application.ScreenUpdating = False

Resetscreen:
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[MARK858]

What do you get with the code below (untested)...

Sub Phone1rev2()                                 '
    ' Enter 1 for Phone Selection
    Dim rStart As Range, mycell As Range

    Application.ScreenUpdating = False
    With Sheets("Activities")
        If .Range("A2") = "" Then
            .Range("A2") = Sheets("Data").Range("B1")
            .Range("B2") = Sheets("Data").Range("D1")
        End If
        If Application.Sum(.Range("E2:H2")) = 0 Then
            .Range("F2").Value = 1
        Else
            Set rStart = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(0, 9)
            If Application.Sum(rStart.Resize(, 32).Value) = 0 Then
                Application.Goto Sheet1.Range("A1")
                MsgBox "Select Activity for last record"
            Else
            
                Set mycell = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2)
                mycell.Value = 1
                If mycell.Offset(, -4) = "" Then
                    mycell = Sheets("Data").Range("B1").Value
                    mycell.Offset(0, 1) = Sheets("Data").Range("D1")
                End If
            End If
        End If
    End With
    
    With Application
        .Goto Sheets("DASHBOARD").Range("A1")
        .ScreenUpdating = True
    End With
End Sub

 

[pjmorris]

thats what I said

 

[MARK858]

No it is not, there is no on error statement and there are no selects/activecells in the last Else statement