Speed this up...

[crakonit]

Hi All, can anyone help me speed this code up? I run out of ideas...

Sub Clear_Arrows_and_Create_Blue_Dot(ro)
Dim Ro_Less_1 As Range
Dim Ro_Plus_1 As Range
Dim Ro_Col_1 As Range
Dim Ro_Col_2 As Range
Dim Ro_Col_3 As Range
Dim Ro_Less_2 As Range
Dim Ro_Plus_2 As Range
Dim dot As String


'Set Ojbects to increasee speed
Set Ro_Less_1 = Cells(ro - 1, 1)
Set Ro_Plus_1 = Cells(ro + 1, 1)
Set Ro_Col_1 = Cells(ro, 1)
Set Ro_Col_2 = Cells(ro, 2)
Set Ro_Col_3 = Cells(ro, 3)
Set Ro_Less_2 = Cells(ro - 2, 2)
Set Ro_Plus_2 = Cells(ro + 2, 2)

dot = ChrW(9679)

'Application.ScreenUpdating = False 'it will speed the code up, but at the cost of a screen fliker! -this can not happen.

x = 1: If Ro_Less_1.EntireRow.Height > 0 Then x = 0
y = 1: If Ro_Plus_1.EntireRow.Height > 0 Then y = 0

'Blue dot
With Ro_Col_2
.Value = dot 'dot
.Font.ColorIndex = 5 'Blue
End With

If x = 1 Then 'Additional blue dot required?
With Ro_Less_2
.Value = dot 'dot
.Font.ColorIndex = 5 'Blue
End With
Else
If ro - 1 - x Mod 2 <> 0 Then Cells(ro - 1 - x, 2).Value = vbNullString 'up arrow
End If

If y = 1 Then 'Additional blue dot required?
With Ro_Plus_2
.Value = ChrW(9679) 'dot
.Font.ColorIndex = 5 'Blue
End With
Else
If ro + 1 + y Mod 2 <> 0 Then Cells(ro + 1 + y, 2).Value = vbNullString 'down arrow
End If

Ro_Col_1.Value = vbNullString 'Left arrow
Ro_Col_3.Value = vbNullString 'Rigth arrow

End Sub

 

[AlphaFrog]

I'm assuming you're calling this procedure within a loop of another procedure. If yes, put the Application.ScreenUpdating = False before the call loop in the other procedure and set it to True after the loop is complete. This should be faster and not flicker.

There may be faster methods than calling this procedure one row at a time, but I would need more info about what you are doing.

 

[crakonit]

Thanks, but adding the screen updating before the procedure did not fully work, some times i get 1 flick and some times I don't get any.

Procedure runs once, for one cell, does not use multiple ranges and it is triggered by a worksheet change event (that's why it can not flick -not even once) when running.

In essence, I have a 'Joystick' as shown in image below. When selecting a blue dot, it destroys the 'Joystick; and create a new one in the place where the blue dot is.

The arrows function on a double click event and they basically move data.

The only lengthly part of all these events (which I have timed) is destroying the arrows then reseting the blue dots -procedure below.


-- removed inline image ---