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

 

[excelbytes]

MARK858 - the issue with the code you provided is the definition of "mycell". In your code, if I have data in C2, , it will go to C2, then the offset will move it to E3 (which is correct) and enter a 1. You then check if mycell.Offset(,-4) = "", but don't make mycell.Offset(,-4) the active cell. Your code enters the information from the "Data" worksheet into E3 & F3 rather than A3 & B3. In my code, I have:

ActiveCell.Offset(0, -4).Select
If ActiveCell = "" Then
ActiveCell = Sheets("Data").Range("B1")
ActiveCell.Offset(0, 1) = Sheets("Data").Range("D1")

 

[JLGWhiz]

OK, this should do it.

Sub Phone1rev3() '
' Enter 1 for Phone Selection
Dim rStart As Range, fn 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
            Set fn = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2)
            fn.Value = 1
                If fn.Offset(, -4) = "" Then
                    fn = Sheets("Data").Range("B1").Value
                    fn.Offset(0, 1) = Sheets("Data").Range("D1")
                End If
       End If
    End If
End With
Sheets("DASHBOARD").Select
Range("A1").Select
End Sub

 

[MARK858]

Your code enters the information from the "Data" worksheet into E3 & F3 rather than A3 & B3. In my code, I have:

Then change the offset based on the position of mycell, there is no need to keep activating cells (which is most of your flicker problem).
Don't miss JLGWhiz's last post.

 

[excelbytes]

I modified your code a bit and this seems to work. Do you see any problem with my changes:

Sub Phone1rev3() '
' Enter 1 for Phone Selection
Dim rStart As Range, fn 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 fn = .Columns("C").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Offset(1, 2)
fn.Value = 1
If fn.Offset(, -4) = "" Then
fn.Offset(, -4) = Sheets("Data").Range("B1").Value
fn.Offset(, -3) = 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

 

[JLGWhiz]

You need to use code tags to keep the formatting of the code. If you have downloaded the XL2BB add in, you can just highlight the code with the mouse pointer an click the '<vba/.> ' icon, else use the regular code tags before and after the code.

If you are satisfied with the code as you have modified it, then all is well.
regards, JLG

 

[MARK858]

If hou have downloaded the XL2BB add in, you can just highlight the code with the mouse pointer an click the '<vba/.> ' icon

Doesn't need the XL2BB add-in for the <vba/> icon, it is part of the board software.