vendredi 27 octobre 2017

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




Aucun commentaire:

Enregistrer un commentaire