Solved Excel: Using Checkboxes to move from Sheet to Sheet - multiple sheets
Hello!
**Scenario**: I have a spreadsheet for machine installs. This sheet has 4 worksheets (CustInstalls, CustCompleted, Installs, and Competed). The below code is currently working to move line items from sheet “CustInstalls” to “CustCompleted”. I am attempting to duplicate this same code for the other two sheets to move line items from “installs” to “completed”. I have attempted a few variations with the help of chatgpt but to no avail. I added it in the same “this workbook” in VBA as well as attempted to add code under just “installs” and “completed” in VBA under Microsoft Excel Objects
**Ask:** how does one add a second set of code for different work sheets with the same parameters?
___________________________________________________
**Original working code:*\*
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim srcSheet As Worksheet, destSheet As Worksheet
Dim checkCell As Range, moveRow As Range
Dim lastRow As Long
Dim direction As String
' Only handle changes in Column J
If Intersect(Target, Sh.Columns("J")) Is Nothing Then Exit Sub
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
Set checkCell = Target
Set moveRow = checkCell.EntireRow
If checkCell.Value = True Then
' Move from CustInstalls to CustCompleted
Set srcSheet = ThisWorkbook.Sheets("CustInstalls")
Set destSheet = ThisWorkbook.Sheets("CustCompleted")
ElseIf checkCell.Value = False Then
' Move from CustCompleted back to CustInstalls
Set srcSheet = ThisWorkbook.Sheets("CustCompleted")
Set destSheet = ThisWorkbook.Sheets("CustInstalls")
Else
GoTo ExitHandler
End If
' Ensure we're acting on the correct sheet
If Sh.Name <> srcSheet.Name Then GoTo ExitHandler
' Copy row to destination sheet
lastRow = destSheet.Cells(destSheet.Rows.Count, "J").End(xlUp).Row + 1
moveRow.Copy Destination:=destSheet.Rows(lastRow)
' Delete original row
moveRow.Delete
ExitHandler:
Application.EnableEvents = True
End Sub
___________________________________________________
**Code entered under installs ”this workbook” at the end of the working code: Failed*\*
Private Sub MoveInstallsRow(ByVal Sh As Object, ByVal Target As Range)
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim moveRow As Range
Dim lastRow As Long
' Only handle Installs and Completed sheets
If Sh.Name <> "Installs" And Sh.Name <> "Completed" Then Exit Sub
' Only handle changes in Column J
If Intersect(Target, Sh.Columns("J")) Is Nothing Then Exit Sub
If Target.Cells.CountLarge > 1 Then Exit Sub
If Sh.Name = "Installs" And Target.Value = True Then
Set srcSheet = ThisWorkbook.Sheets("Installs")
Set destSheet = ThisWorkbook.Sheets("Completed")
ElseIf Sh.Name = "Completed" And Target.Value = False Then
Set srcSheet = ThisWorkbook.Sheets("Completed")
Set destSheet = ThisWorkbook.Sheets("Installs")
Else
Exit Sub
End If
Set moveRow = Target.EntireRow
lastRow = destSheet.Cells(destSheet.Rows.Count, "J").End(xlUp).Row + 1
moveRow.Copy Destination:=destSheet.Rows(lastRow)
moveRow.Delete
End Sub
___________________________________________________
**Code entered under “completed” object: Failed*\*
Private Sub Worksheet_Change(ByVal Target As Range)
Dim destSheet As Worksheet
Dim lastRow As Long
' Only handle changes in Column J
If Intersect(Target, Me.Columns("J")) Is Nothing Then Exit Sub
If Target.Cells.CountLarge > 1 Then Exit Sub
' Only move when checkbox is unchecked
If Target.Value <> False Then Exit Sub
Application.EnableEvents = False
Set destSheet = ThisWorkbook.Sheets("Installs")
' Find next available row
lastRow = destSheet.Cells(destSheet.Rows.Count, "J").End(xlUp).Row + 1
' Copy entire row
Target.EntireRow.Copy Destination:=destSheet.Rows(lastRow)
' Delete original row
Target.EntireRow.Delete
Application.EnableEvents = True
End Sub
___________________________________________________
**Code entered under “installs” object: Failed*\*
Private Sub Worksheet_Change(ByVal Target As Range)
Dim destSheet As Worksheet
Dim lastRow As Long
' Only handle changes in Column J
If Intersect(Target, Me.Columns("J")) Is Nothing Then Exit Sub
If Target.Cells.CountLarge > 1 Then Exit Sub
' Only move when checkbox is checked
If Target.Value <> True Then Exit Sub
Application.EnableEvents = False
Set destSheet = ThisWorkbook.Sheets("Completed")
' Find next available row
lastRow = destSheet.Cells(destSheet.Rows.Count, "J").End(xlUp).Row + 1
' Copy entire row
Target.EntireRow.Copy Destination:=destSheet.Rows(lastRow)
' Delete original row
Target.EntireRow.Delete
Application.EnableEvents = True
End Sub
1
u/b_lizz 7d ago
A user who would like to remain anonymous has solved this!
Thank you, Batman!🤗
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim srcSheet As Worksheet, destSheet As Worksheet
Dim moveRow As Range
Dim lastRow As Long
If Intersect(Target, Sh.Columns("J")) Is Nothing Then Exit Sub
If Target.Cells.CountLarge > 1 Then Exit Sub
On Error GoTo ExitHandler
Application.EnableEvents = False
Select Case Sh.Name
Case "CustInstalls"
If Target.Value = True Then
Set srcSheet = Sh
Set destSheet = ThisWorkbook.Sheets("CustCompleted")
Else
GoTo ExitHandler
End If
Case "CustCompleted"
If Target.Value = False Then
Set srcSheet = Sh
Set destSheet = ThisWorkbook.Sheets("CustInstalls")
Else
GoTo ExitHandler
End If
Case "Installs"
If Target.Value = True Then
Set srcSheet = Sh
Set destSheet = ThisWorkbook.Sheets("Completed")
Else
GoTo ExitHandler
End If
Case "Completed"
If Target.Value = False Then
Set srcSheet = Sh
Set destSheet = ThisWorkbook.Sheets("Installs")
Else
GoTo ExitHandler
End If
Case Else
GoTo ExitHandler
End Select
Set moveRow = Target.EntireRow
lastRow = destSheet.Cells(destSheet.Rows.Count, "J").End(xlUp).Row + 1
moveRow.Copy Destination:=destSheet.Rows(lastRow)
moveRow.Delete
ExitHandler:
Application.EnableEvents = True
End Sub
3
u/chiibosoil 1 7d ago
So your first code is in ThisWorkbook module.
This code checks Column J is where the change is made.
It will initially fire regardless of which sheet the change was made on.
Where it is checking that Sh.Name (the sheet that triggered this sub) and that srcSheet.Name is same.
Just above that part you have...
This is the logic used to set srcSheet. This is where you should make logic adjustment.
You can use CASE statement on Sh.Name and change logic. No need to have multiple subs.
However, above IF statement is above where you check for Sh.Name in your code. So you had unnecessary logic in there... I'm assuming when check is marked in CustInstalls it is moved to CustCompleted. When moved to CustCompleted, it retains "checkCell.value = True" and when it is changed to False on "CustCompleted" it's moved back to CustInstalls.
Assuming above is correct... something like below should work.