Move Row To a Particular Sheet Based on Cell Value

[sliesneekr]

I have created a simple inventory of my DVD's and Cd's. Three sheets in my workbook, At Home, Loaned Out and On Hold. Column C, in each sheet, which is named Status has a dropdown list with three choices, happen to also be At Home, Loaned out and On Hold. What I am after is when I choose the dropdown list I would like that row to be moved to the corresponding sheet. My current VBA will move the row from At Home sheet to Loaned out, can't figure out how to get them to move back and forth. This is the code that is attached to the At Home sheet, when I put this on the Loaned Out sheet and change it accordingly it doesn't work. Any Suggestions?

Option Explicit

Private Sub Worksheet_change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If target.Column <> 3 Then Exit Sub
If target.Value <> "Loaned Out" Then Exit Sub
Dim i&
With Sheets("Loaned Out")
    i = .Cells(Rows.Count, 1).End(xlUp).Row: If i = 1 Then i = 2
    target.EntireRow.Copy Destination:=.Cells(i + 1, 1)
End With
target.EntireRow.Delete
End Sub

[mehmetcik]

Ok so you want a macro to work on three sheets.

so why would you use a sheet specific macro?

You should be using a workbook module.

Open Visual Basic select view and then project explorer

Find your project and double click on the This Workbook icon

Paste this code there. It will work correctly on all three sheets.

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

If Target.Cells.Count > 1 Or Target.Column <> 3 Or Target.Value = ActiveSheet.Name Then Exit Sub
MyArray = Array("Loaned Out", "At Home", "On Hold")
If IsError(Application.Match(Target.Value, MyArray, 0)) Then Exit Sub
Application.EnableEvents = False
    Rows(Target.Row).Cut
    
    With Sheets(Target.Value).Range("A1")
    .Insert Shift:=xlDown
    End With
    
Application.EnableEvents = True
End Sub

[sliesneekr]

Wow, that is to the point and works great, thank you, very much appreciated!

[Greg M]

Hi there,

See if the attached workbook does what you need - it uses the following code:

ThisWorkbook VBA CodeModule:

Option Explicit


'=========================================================================================
'=========================================================================================


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Call MoveAlbum(rSource:=Target)
End Sub

Standard VBA CodeModule:

Option Private Module
Option Explicit


'=========================================================================================
'=========================================================================================


Public Sub MoveAlbum(rSource As Range)

    Dim vaDataValues    As Variant
    Dim sTargetSheet    As String
    Dim iLastRowNo      As Integer
    Dim wksSource       As Worksheet
    Dim wksTarget       As Worksheet

'   Proceed only if the value of a single cell in the Status column has changed
    If mbSelectionIsValid(rSource:=rSource) Then

'       Locate the worksheet from which the record is being removed
        Set wksSource = rSource.Parent

'       Determine the name of the worksheet to which the record is being transferred
        sTargetSheet = rSource.Value

'       Proceed only if the name of the target worksheet has been determined
        If sTargetSheet <> vbNullString Then

'           Locate the worksheet to which the record is being transferred
            Set wksTarget = ThisWorkbook.Worksheets(sTargetSheet)

'           Locate the entire row in which the source record is located
            With rSource.EntireRow

'               Locate the first three cells in the above (source) row
                With Range(.Cells(1, 1), .Cells(1, 3))

'                   Store  the values of the above cells in an array variable
                    vaDataValues = .Value

'                   Clear the values from the three cells
                    .ClearContents

'                   Sort the records in the source worksheet to "remove" the empty row
                    With .EntireColumn
                        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
                    End With

                End With

            End With

'           Move to the target worksheet
            With wksTarget

'               Determine the row number of the first empty row in the worksheet
                iLastRowNo = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                iLastRowNo = iLastRowNo + 1

'               Assign the values stored in the array variable to the first three cells
'               in the first empty row in the target worksheet
                With .Rows(iLastRowNo)
                    Range(.Cells(1, 1), .Cells(1, 3)).Value = vaDataValues
                End With

'               Sort the records in the target worksheet
                .Cells.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes

            End With

        End If

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Function mbSelectionIsValid(rSource As Range) As Boolean

    Const sSTATUS_COLUMN    As String = "C"

    Dim iNoOfCells          As Integer
    Dim wksSource           As Worksheet

    Set wksSource = rSource.Parent

    If Not Intersect(rSource, wksSource.Columns(sSTATUS_COLUMN)) Is Nothing Then

          On Error Resume Next
              iNoOfCells = 0
              iNoOfCells = rSource.Cells.Count
          On Error GoTo 0

          If iNoOfCells = 1 Then
                mbSelectionIsValid = True
          Else: mbSelectionIsValid = False
          End If

    Else: mbSelectionIsValid = False

    End If

End Function

I've modified things a little in that the dropdown list in each worksheet shows only the names of the two other worksheets - i.e. you don't have the option of transferring a data record from one worksheet to the same worksheet.

Also, the data records in the source and target worksheets are sorted by Album Name after each transfer operation.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[sliesneekr]

Thanks Greg M., that is awesome work. I thank you for taking the time to code it but mostly I appreciate the time you took to explain how each line works. I'm slowly learning the language and it helps when I can follow the process in my head, it allows me to use all or pieces of the code later in other work. Thanks again, it worked perfectly!

[Greg M]

Hi again,

Many thanks for your feedback, for taking the trouble to thank me not once, but twice, and also for the Reputation increase - much appreciated

I'm very pleased that you found my post so useful.

Best regards,

Greg M