Saturday, November 24, 2018

excel - Checkboxes are running macro on selected cell row; Need them to run on linked cell row

I have a workbook in which specific line items are to be completed by a staff member and, once completed, they are to be checked off as complete. This triggers the row/range to the left of the checkbox to be selected, copied and pasted into the next worksheet on the first available row. The current row is then cleared from the first worksheet. Each worksheet has the checkboxes pre-filled in and pre-linked to cells. The issue I'm having is that when the checkbox is selected, the runall macro activates on the row that is currently selected instead of the row that the checkbox resides in and is linked to the cell in. So, for example, if the checkbox is in row M2 but the currently selected cell is B8, the macro will try to copy and paste row 8 instead of the intended row 2. As there is no undo with macros this results in a major headache. Any help would be greatly appreciated!



Sub RUNALLOPEN()

Dim response As VbMsgBoxResult
response = MsgBox("Are you sure you wish to clear this row and send to the Lab?", vbYesNo + vbExclamation, "Confirm Error Resolution")
If response = vbNo Then
Dim cbx As CheckBox
Set cbx = ActiveSheet.CheckBoxes(Application.Caller)
With cbx.TopLeftCell.Offset(0, -1)
cbx.Value = xlOff
End With
Exit Sub
End If

If response = vbYes Then
'rest of code
Call movedataOPEN2LAB
Call clearcellsOPEN
End If
End Sub


Sub movedataOPEN2LAB()
Dim cbx As CheckBox


'Application.Caller returns the name of the CheckBox that called this macro
Set cbx = ActiveSheet.CheckBoxes(Application.Caller)

'.TopLeftCell returns the cell address located at the top left corner of the cbx checkbox
With cbx.TopLeftCell.Offset(0, -1)

'Check the checkbox status (checked or unchecked)
If cbx.Value = xlOn Then
' Checkbox is Checked

Range(Cells(cbx.TopLeftCell.Offset(0, -1).Row, 1), Cells(cbx.TopLeftCell.Offset(0, -1).Row, 11)).Select
Selection.Copy
Sheets("Lab").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
ActiveSheet.Range("H" & Selection.Row).Formula = "=VLOOKUP(INDIRECT(""G"" & ROW()),'Source Data'!$D$1:$J$36,6,FALSE)"
ActiveSheet.Range("I" & Selection.Row).Value = "Lab"
Range("A2").Select
End If
End With

End Sub


Sub clearcellsOPEN()
On Error Resume Next
Worksheets("Open").Activate
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 15)).Select
Selection.SpecialCells(xlCellTypeConstants).ClearContents
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 1)).Select
End Sub



Thank you for your help! Here's what I came up with:



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 13 Then
'If UCase(Target.Value) <> "X" Then
' Dim response As VbMsgBoxResult
' response = MsgBox("You must input 'x' in order to move this row.", vbOKOnly + vbExclamation, "ERROR")
' Exit Sub

' End If
If UCase(Target.Value) = "X" Then
response = MsgBox("Are you sure you wish to clear this row and send to the Lab?", vbYesNo + vbExclamation, "Confirm Error Resolution")
If response = vbNo Then
Target.Value = ""
Exit Sub
End If
If response = vbYes Then
'rest of code
Target.Cells.Offset(0, -12).Select

Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 11)).Select
Selection.Copy
With Sheets("Lab")
.Select
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
End With
ActiveSheet.Paste
ActiveSheet.Range("H" & Selection.Row).Formula = "=VLOOKUP(INDIRECT(""G"" & ROW()),'Source Data'!$D$1:$J$36,6,FALSE)"
ActiveSheet.Range("I" & Selection.Row).Value = "Lab"
With Sheets("Open")

.Select
On Error Resume Next
Target.Cells.Offset(0, -12).Select
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 14)).Select
Selection.SpecialCells(xlCellTypeConstants).ClearContents
End With
End If
End If
End If
End Sub

No comments:

Post a Comment

plot explanation - Why did Peaches&#39; mom hang on the tree? - Movies &amp; TV

In the middle of the movie Ice Age: Continental Drift Peaches' mom asked Peaches to go to sleep. Then, she hung on the tree. This parti...