Move rows from one sheet to another when a cell value is changed

I'm new to VBA so I'm probably making some beginner mistakes, please bare with me.

Here is the summary of my goal : I have several sheets in an Excel Workbook with the same structure. In each of those, I have a "Project Status" column with numbers ranging from 0 to 12. I'm trying to monitor a change in the column and, if the value of a cell changes, the row gets moved to the corresponding sheet and location.

My problem is that my code works but leaves an empty row where the row was cut. I tried adding

Target.EntireRow.Delete

but, if I add it before Insert the inserted row is empty, if I add it after it doesn't seem to do anything.

Here is a shorter version of my code, that I have in every sheet that is concerned by it :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("A:A")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

  On Error GoTo bm_Safe_Exit
        Application.ScreenUpdating = False

         If Target.Value = 0 Then
             Target.EntireRow.Cut
             IdeasUpcoming.Range("4:4").Insert
            End If
    
         If Target.Value = 1 Then
               Target.EntireRow.Cut
               IdeasUpcoming.Range("4:4").Insert
            End If
    
         If Target.Value = 2 Then
               Target.EntireRow.Cut
               Current.Range("STATUSNewProjects").Offset(1, 0).Insert
            End If
     
         If Target.Value = 3 Then
               Target.EntireRow.Cut
               Current.Range("STATUSAdvancedProjects").Offset(1, 0).Insert
            End If
      
         If Target.Value = 4 Then
               Target.EntireRow.Cut
               Completed.Range("STATUSFinished").Offset(1, 0).Insert
            End If
       
         If Target.Value = 5 Then
               Target.EntireRow.Cut
               Completed.Range("STATUSOld").Offset(1, 0).Insert
            End If
        
End If

bm_Safe_Exit:
    Application.ScreenUpdating = True

End Sub

How can I delete the row I'm cutting? I'm sure the If / End If for each cell value aren't optimal, is there a way to simplify this (considering this is shortened, in reality I have 13 values)?

Thank you a lot for your help.

CodePudding user response：

You can use the range.copy logic like this - then you can delete the row afterwards:

With Target.EntireRow
   .Copy IdeasUpcoming.cells(4,1)
   .Delete xlShiftUp
End With

Regarding your multiple checks: Maybe you can create a configuration array, which holds per index the target sheets range after that the row should be inserted

Dim arrTarget(1 to 15) as range
set arrTarget(1) = IdeasUpcoming.Cells(4,1)
...
set arrTarget(4) = Completed.Range("STATUSFinished")

Then you can use it like this - without Ifs:

'insert new row for row to be copied
arrTarget(Target.value).Offset(1).EntireRow.Insert xlShiftDown
With Target.EntireRow
   .Copy arrTarget(Target.value).Offset(1)
   .Delete xlShiftUp
End With

Furthermore you should have one generic copy routine in a normal module

Public sub moveRows(Target as range)
'define arrTarget
'do the copying
End sub

And then you call this generic routine from either all worksheet_change routines

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A:A")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
         moveRows target  '-- this is where you call the generic sub
    end if
End Sub

Or - if you have a sheetname logic to identify the relevant worksheets, e.g. data1, data2 etc. then you could use the workbook_SheetChange event (in the ThisWorkbook-module)

```vba
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name Like "data*" Then
    Dim KeyCells As Range
    Set KeyCells = Range("A:A")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
         moveRows Target  '-- this is where you call the generic sub
    End If
End If

End Sub


In case you have to make changes to your move-routine or the worksheet_change event, you only have to make changes in one place :-). (DRY: Don't repeat yourself)