I have a document where you can move or copy a row, there is a "move" and "copy" button, both are toggle buttons
'VARIABLES
Const sSTARTROW As String = "A"
Const sENDROW As String = "O"
Const sMOVEBUTTON As String = "Move line"
Const sCOPYBUTTON As String = "Copy line"
Dim sClipboard() As String
Dim iRowNumberBackup As Integer
Private Sub MoveButton_Click()
Dim sRange As String
Dim rDataRange As Range
Select Case MoveButton.Value
'pushed
Case True
GetData ActiveCell.Row, False
'released
Case False
DropData ActiveCell.Row
End Select
End Sub
Private Sub CopyButton_Click()
Select Case CopyButton.Value
'pushed
Case True
GetData ActiveCell.Row, True
'released
Case False
DropData ActiveCell.Row
End Select
End Sub
And these are the functions.
Function GetData(iRowNumber As Integer, bCopy As Boolean)
Dim cell As Range
'set the row number were data was taken from to set back in case of emergency
iRowNumberBackup = iRowNumber
'create the range that needs to be moved
sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
'copy value into dynamic range
Set rDataRange = Range(sRange)
'if the line is empty stop everything
If rDataRange(1, 1) = 0 Then
MsgBox ("empty line")
Exit Function
End If
'define array size depending the size of range
ReDim sClipboard(rDataRange.Columns.Count)
'put the value of range into the array
Dim i As Integer: i = 0
For Each cell In rDataRange.Cells
sClipboard(i) = cell.Value
i = i 1
Next cell
'check if it's copy or move
Select Case bCopy
Case True
'change button description
CopyButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
Case False
'remove data that was placed in the array
Range(sRange).ClearContents
'change button description
MoveButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
End Select
End Function
.
Function DropData(iRowNumber As Integer)
Dim cell As Range
'create the range that needs to be moved
sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
'set the new range
Set rDataRange = Range(sRange)
'if the line is already with data set back in previous row where it was copied & stop everything
If rDataRange(1, 1) <> 0 Then
MsgBox ("Data already in this line")
DropData (iRowNumberBackup)
Exit Function
End If
'copy value from the array into the selected range
Dim i As Integer: i = 0
For Each cell In rDataRange.Cells
cell.Value = sClipboard(i)
i = i 1
Next cell
'empty array
Erase sClipboard
'change button description
MoveButton.Caption = sMOVEBUTTON
CopyButton.Caption = sCOPYBUTTON
End Function
I would like to avoid copying / moving empty lines, as well as not overwriting a line with data yet (or at least give a warning). See msgbox in the code. What property can I use to change it so after the first click, the button goes back into the "released" state ? When I do just "value = false" the click event is triggered again. If a "simple" button instead of a Active X toggle button is a solution, this solution would also be great. It's just for usability it took this toggle button. Thanks for your input.
PS: also I would prefer to pass the button itself to the formula instead of a boolean where I have to do a check.
CodePudding user response:
Meanwhile I found a (temporary?) solution, to call again the click event of the button, this way the button is back in "released" mode. Here's (for one button) the code:
Sub MoveButton_Click()
'check for avoiding endless loop
If Not bEmptyline Then
Dim sRange As String
Dim rDataRange As Range
DisableOtherButton (False)
Select Case MoveButton.Value
'clicked
Case True
GetData ActiveCell.Row, False
'released
Case False
DropData ActiveCell.Row
End Select
End If
End Sub
.
Function GetData(iRowNumber As Integer, bCopy As Boolean)
Dim cell As Range
'set the row number were data was taken from to set back in case of emergency
iRowNumberBackup = iRowNumber
'create the range that needs to be moved
sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
'copy value into dynamic range
Set rDataRange = Range(sRange)
'if the line is empty stop everything
If rDataRange(1, 1) = 0 Then
EmptyLine (bCopy)
Exit Function
End If
'define array size depending the size of range
ReDim sClipboard(rDataRange.Columns.Count)
'put the value of range into the array
Dim i As Integer: i = 0
For Each cell In rDataRange.Cells
sClipboard(i) = cell.Value
i = i 1
Next cell
'check if it's copy or move
Select Case bCopy
Case True
'change button description
CopyButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
Case False
'remove data that was placed in the array
Range(sRange).ClearContents
'change button description
MoveButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
End Select
End Function
.
Function EmptyLine(bCopy As Boolean)
whatever = MsgBox("Empty row selected.", vbInformation)
'change empty line to avoid endless loop (for every time click event)
bEmptyline = True
'recall click to set button back to standard state (not clicked but released), BETTER SOLUTION ???
Select Case bCopy
'coming from the copy button
Case True
CopyButton.Value = Not CopyButton.Value
Sheet1.CopyButton_Click
'coming from the move button
Case False
MoveButton.Value = Not MoveButton.Value
Sheet1.MoveButton_Click
End Select
'set back to false for next time
bEmptyline = False
End Function