SpinButton

[mdmackillop]

I'm looking to use the SpinButton to order a list of files, but it's a bit sluggish. Any suggested improvements? I want to avoid adding a numbered helper column and using that.

[Zack Barresse]

What about using arrays instead?

Dim Rw As Long
Dim vTemp As Variant
Dim aVals() As Variant

Const iStartCol As Long = 5

Private Sub SpinButton1_SpinUp()
If ActiveCell.Column <> 3 Then Exit Sub
Rw = ActiveCell.Row
If Rw <= iStartCol Then Exit Sub
aVals = Range("C" & iStartCol & ":C" & Cells(Rows.Count, 3).End(xlUp).Row).Value
vTemp = aVals(Rw - iStartCol, 1)
aVals(Rw - iStartCol, 1) = aVals(Rw - iStartCol + 1, 1)
aVals(Rw - iStartCol + 1, 1) = vTemp
Range("C" & iStartCol & ":C" & Cells(Rows.Count, 3).End(xlUp).Row).Value = aVals()
DoEvents
Cells(Rw - 1, 3).Activate
End Sub

Private Sub SpinButton1_SpinDown()
If ActiveCell.Column <> 3 Then Exit Sub
Rw = ActiveCell.Row
If Rw <= iStartCol Then Exit Sub
aVals = Range("C" & iStartCol & ":C" & Cells(Rows.Count, 3).End(xlUp).Row).Value
vTemp = aVals(Rw - iStartCol + 1, 1)
aVals(Rw - iStartCol + 1, 1) = aVals(Rw - iStartCol + 2, 1)
aVals(Rw - iStartCol + 2, 1) = vTemp
Range("C" & iStartCol & ":C" & Cells(Rows.Count, 3).End(xlUp).Row).Value = aVals()
DoEvents
Cells(Rw + 1, 3).Activate
End Sub

HTH

[Bob Phillips]

Malcolm,

Instead of cutting and pasting, sort the two cells.

You will need to check if the value is greater or less thatn the value it is replacing, and sort descending or ascending accordingly, but it should be quicker.

[Zack Barresse]

Hiya Bob!

I thought of sorting, but you'd need an additional column, or more array work. I'd still stick with the array I think.

[GTO]

Hi Malcom,

Unless you are handy, I may have to read your response later tonight. Just past noon here, but probably should get a bit of shuteye. Anyways, just mentioned in case I'm logged out, we'll see if I can shutdown.

Okay, I tried the workbook and it might be my traumatized, overheated, POL, but it seemed to me that the major slow-down is the .Insert; I suspect as Excel has to go check all the way up or down (less than technical answer, but you know what I mean).

So as it seems you are just moving the vals, I went that way and noted that the spinbutton seems awfully fond of hanging onto the focus, even with the DoEvents.

Finally, I checked SpinButton and spotted the Delay property. It would seem to me that a "slow" click could run the procedure several times. Only a cursory check, but tacking in a MsgBox seemed to indicate affirmation.

So, how about two command buttons?


Option Explicit

Dim Rw As Long

Private Sub cmdUP_Click()
Dim vntCutVal As Variant, vntDestVal As Variant

If Not ActiveCell.Column = 3 Or ActiveCell.Row < 6 Then Exit Sub

Rw = ActiveCell.Row

vntCutVal = ActiveCell.Value

ActiveCell.Value = ActiveCell.Offset(-1).Value

ActiveCell.Offset(-1).Value = vntCutVal

DoEvents

Me.Cells(Rw - 1, 3).Select
End Sub

Private Sub cmdDN_Click()
Dim vntCutVal As Variant

If Not ActiveCell.Column = 3 Or ActiveCell.Row = Me.Rows.Count Then Exit Sub

Rw = ActiveCell.Row

vntCutVal = ActiveCell.Value

ActiveCell.Value = ActiveCell.Offset(1).Value

ActiveCell.Offset(1).Value = vntCutVal

Me.Cells(Rw + 1, 3).Select
End Sub

Hope that helps,

Mark

[Bob Phillips]

Hiya Bob!

I thought of sorting, but you'd need an additional column, or more array work. I'd still stick with the array I think.

Why, you can sort by the two values in consideration?

[GTO]

Hoy Vey! You guys are fast :-) I thought it had only been a few minutes since I checked.

[Zack Barresse]

Why, you can sort by the two values in consideration?
Always thinking outside the box, aren't ya. ;)

[mdmackillop]

Thanks All,
I'll check these out tomorrow.
Regards
Malcolm

[mdmackillop]

I've gone with Bob's suggestion but using Shapes instead of the SpinButton as I could not get the focus back to the sheet after each click.

Sub SpinUp()
Dim c As Range
Dim Test As Boolean

Set c = ActiveCell
Application.ScreenUpdating = False
If c.Row <= 5 Then Exit Sub
Range("C2").Formula = "=" & c.Address & ">" & c.Offset(-1).Address
If Range("C2") Then
c.Offset(-1).Resize(2, 2).Sort Key1:=c, Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Else
c.Offset(-1).Resize(2, 2).Sort Key1:=c, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End If
c.Offset(-1).Activate
Application.ScreenUpdating = True
End Sub


Also an unexpected comparison result comparing two cells. A code comparison returns False, a worksheet comparison returns True, hence the formula line.
Still a "work in progress" to make PDF printing easier.

[Bob Phillips]

Nor could I Malcolm, but it I did get it back after a second click. Very odd.

[Zack Barresse]

I couldn't get the Sort method to compare speed-wise compared to the array method in any of the time tests I ran. Did anyone else have other results? The methods weren't using the spin buttons though, just in a standard module.


Nor could I Malcolm, but it I did get it back after a second click. Very odd.
Ditto. Although the behavior was the same, i.e. if the procedure was run a second time, and a third time the focus was shown. Definitely odd.

[mdmackillop]

There is no problem with the focus if you step through the macro.

Zack,
I've not tried the Arrays using Shapes to trigger. I'll give it a go.