Custom Spin Button Based On Values Passed From Array

[Preeti Verma]

@ExcelFox
@Zack Barresse


Thanks for your concise solution & quick response.

I needed two custom shapes for my problem which actually involved Java Swing API simulation on Excel using VBA coding.

[Preeti Verma]

@ExcelFox
@Zack Barresse


Thanks for your concise solution & quick response.

I needed two custom shapes for my problem which actually involved Java Swing API simulation on Excel using VBA coding.

Thanks again!





@Zack Barresse

I have modified your code a bit to make spin truly circular as under:

Option Explicit
Dim oBtnClk As Shape
Dim WS As Worksheet
Dim rCell As Range
Dim arr() As String
Dim iPos As Long
Const sArr As String = "Txt1, Txt2, Txt3, Txt4, Txt5, Txt6, Txt7, Txt8, Txt9, Txt10, Txt11, Txt12"
Const sTargetSheet As String = "Sheet1"
Const sTargetCell As String = "E4"

Sub Increase()
Set oBtnClk = Nothing
Set WS = Worksheets(sTargetSheet)
Set rCell = WS.Range(sTargetCell)
On Error Resume Next
Set oBtnClk = WS.Shapes(Application.Caller)
arr = Split(sArr, ", ")
iPos = WorksheetFunction.Match(rCell.Value, arr(), 0)
On Error GoTo 0
If oBtnClk Is Nothing Then Exit Sub
If iPos = 0 Then
rCell.Value = arr(LBound(arr))
Exit Sub
End If
'**************************
If iPos - 1 = UBound(arr) Then
iPos = LBound(arr)
End If
rCell.Value = arr(iPos)
'**************************
End Sub

Sub Decrease()
Set oBtnClk = Nothing
Set WS = Worksheets(sTargetSheet)
Set rCell = WS.Range(sTargetCell)
On Error Resume Next
Set oBtnClk = WS.Shapes(Application.Caller)
arr = Split(sArr, ", ")
iPos = WorksheetFunction.Match(rCell.Value, arr(), 0)
On Error GoTo 0
If oBtnClk Is Nothing Then Exit Sub
If iPos = 0 Then
'not set yet
rCell.Value = arr(LBound(arr))
Exit Sub
End If
'*****************************
If iPos - 1 = LBound(arr) Then
iPos = UBound(arr) + 2
End If
'*****************************
rCell.Value = arr(iPos - 2)
End Sub


Now, both code works identically.

Attaching modCustomSpinButton.xlsm file with both functioning!