Solved: Why does creating activex button on sheet interfere with value stored in PrevCol var

[frank_m]

If I use this code and I exit the sub before the second portion of the code runs, it works fine to scroll left or right one cell at a time depending on the selection made left or right.

But if I uncomment the Exit Sub '(2ND HALF) of code, which creates a shape to underline the selected row, my prevCol variable no longer effects the first half on the code, causing it to always scroll right no matter whether the selection is changed to the right or left.
Any idea how I can get it to work/ (by the way I do not want to use conditional formatting to highlight the selection, for reasons that it would take too long to explain. (Sample workbook attached)

Thanks

Edit: I noticed now that the 1st half of the code some times works, but most of the time does nothing. - But if I comment out the Exit sub to allow the 2nd half of the code to run, the 2nd half works fine, and the 1st half works, except not as expected.
- If I completely delete the 2nd half of the code, then the 1st half works fine
[vba]
Option Explicit

Private prevCol As Integer
Private prevRow As Long
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim iLeft As Integer, iTop As Long, iWidth As Integer, iHeight As Integer
Dim shp As Object


If target.Row > 2 Then

With ActiveSheet

If target.Column > 12 And target.Column > prevCol Then

ActiveWindow.SmallScroll ToRight:=1 ' scroll right 1, when selecting next cell to right

ElseIf target.Column < prevCol Then

ActiveWindow.SmallScroll ToRight:=-1 ' scroll left 1, when selecting next cell to left

End If

End With
End If
prevCol = target.Column

'//***//'//***//'//***//'//***//'//***//
Exit Sub 'Comment out the Exit Sub here to run (2ND HALF) of code. - You will see 1st half act goofy
'//***//'//***//'//***//'//***//'//***//
If Not prevRow = target.Row Then
For Each shp In ActiveSheet.Shapes

If shp.Name <> "CommandButton1" And shp.Width > 700 Then
shp.Delete
End If
Next

iTop = target.Top + target.Height
iHeight = 3
iLeft = target.EntireRow.Cells(3).Left
iWidth = target.EntireRow.Cells(3).Resize(, 28).Width

If target.Row > 1 And Selection.Rows.Count = 1 Then
Set shp = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=iLeft, Top:=iTop, Width:=iWidth, Height:=iHeight)

shp.Object.TakeFocusOnClick = False
shp.Name = "UnderlineRow"
End If
End If
prevRow = target.Row

End Sub
[/vba]

[Aflatoon]

When you add an ActiveX control, your project resets and your variables lose state. Either store the value in a defined name, or use a Forms button instead (with Buttons.Add) They are generally more reliable on worksheets anyway.

[frank_m]

HI Aflatoon,

Thanks for your advise. Switching to using the Forms type sheet button did indeed solve the problem.

I remember now why I had originally decided to use the activex, it was so I could change the color of the underline, but the system color is fine; I'm a very happy camper now, thanks to you.
(There were reasons why I originally opted against usually a simple textbox for this, but it was quite awhile ago, so I can't remember)

Thanks again

Here's the new code:
[vba]

Option Explicit

Private PrevCol As Integer
Private prevRow As Long

Private Sub Worksheet_SelectionChange(ByVal target As Range)

Dim iLeft As Integer, iTop As Long, iWidth As Integer, iHeight As Integer
Dim shp As Object

If Not Me.ProtectContents Then
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True, userinterfaceonly:=True
End If

If target.Row > 1 Then

With ActiveSheet

If PrevCol > target.Column Then

ActiveWindow.SmallScroll ToRight:=-1 ' scroll left 1, when selecting next cell to left

ElseIf target.Column > 12 And PrevCol > 12 Then

ActiveWindow.SmallScroll ToRight:=1 ' scroll right 1, when selecting next cell to right

End If

End With

End If

PrevCol = target.Column


If Not prevRow = target.Row Then

For Each shp In ActiveSheet.Shapes

If shp.Width > 700 Then
If Me.ProtectContents Then ActiveSheet.Unprotect
shp.Delete
End If
Next

iTop = target.Top + target.Height
iHeight = 2
iLeft = target.EntireRow.Cells(3).Left
iWidth = target.EntireRow.Cells(3).Resize(, 26).Width

If target.Row > 1 And Selection.Rows.Count = 1 Then

Set shp = ActiveSheet.Shapes.AddFormControl _
(Type:=xlButtonControl, Left:=iLeft, Top:=iTop, Width:=iWidth, Height:=iHeight)

shp.Name = "UnderlineRow"

End If

End If

prevRow = target.Row

End Sub
[/vba]
properly functioning workbook example attached for anyone that might be interested.

[]

[frank_m]

Slight bug in last code and attachment
I neglected to re-protect the sheet after deleting the shape

Revised code below (made possible due to the kind assistance of member Aflatoon)
[vba]
Option Explicit

Private PrevCol As Integer
Private prevRow As Long

Private Sub Worksheet_SelectionChange(ByVal target As Range)

Dim iLeft As Integer, iTop As Long, iWidth As Integer, iHeight As Integer
Dim shp As Object

If target.Row > 1 Then

With Me

If PrevCol > target.Column Then

ActiveWindow.SmallScroll ToRight:=-1 ' scroll left 1, when selecting next cell to left

ElseIf target.Column > 12 And PrevCol > 12 Then

ActiveWindow.SmallScroll ToRight:=1 ' scroll right 1, when selecting next cell to right

End If

End With

End If

PrevCol = target.Column


If Not prevRow = target.Row Then

For Each shp In Me.Shapes

If shp.Width > 700 Then
If Me.ProtectContents Then Me.Unprotect
shp.Delete
Me.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True, userinterfaceonly:=True
'Moved the protection to here.. It had been father up in the code.
End If
Next

iTop = target.Top + target.Height
iHeight = 2
iLeft = target.EntireRow.Cells(3).Left
iWidth = target.EntireRow.Cells(3).Resize(, 26).Width

If target.Row > 1 And Selection.Rows.Count = 1 Then

Set shp = Me.Shapes.AddFormControl _
(Type:=xlButtonControl, Left:=iLeft, Top:=iTop, Width:=iWidth, Height:=iHeight)

shp.Name = "UnderlineRow"

End If

End If

prevRow = target.Row

End Sub
[/vba]
attached new version