locked
Automatically move data between sheets RRS feed

  • Question

  • Hello,

    I am looking for a way to conditionally move data between sheets within a workbook. I am new to using macros/formulas and everything I've read is complete gibberish to me. What my end goal is: I want to have a column of data, and if a value is set to "Complete" in the column, the whole row is automatically transferred to a new row on another sheet within the workbook. If this is not possible and I just have to cut/paste, then I will do that. I'm just looking in the community to see if such a thing is possible, and where I could look to get guidance on how to accomplish this.

    Best regards,

    CW Flippo


    • Edited by CW_Flippo Thursday, February 22, 2018 11:28 PM Clarification
    Thursday, February 22, 2018 11:13 PM

All replies

  • Hi CW Flippo,

    Based on your description, I created a sample about your requirement, I use this array formula, please enter this formula with Shift+Ctrl+Enter:

    =INDEX(Sheet1!A:A,SMALL(IF(Sheet1!$E$2:$E$100=MID(CELL("FILENAME",A2),FIND("]",CELL("FILENAME"))+1,100),ROW($E$2:$E$100),8000),ROW(1:1)))

    Sheet1:

    Please check if this is what you need and let me know if you would like further assistance.

    I'm glad to help you.

    Regards,

    Emi


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.


    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Teams.

    Friday, February 23, 2018 2:52 AM
  • Hi,

    I'm not sure if I can understand correctly what you want to do.
    I made a sample:
         
    ' --- when cell A1 changed to "Complete", move one column to another sheet
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       If Intersect(Target, Range("A1")) Is Nothing Then
            ' -- nothing changed
            Exit Sub
        Else
            Dim firstCol As Integer
            ' -- cell [A1] changed
            If (Range("A1").Value = "Complete") Then
                firstCol = fnc_FirstColumn      ' -- get 1st column for moving (From > To)
                Call prc_MoveValue(firstCol)    ' -- move (From) > (To): actually copy and delete
                Range("A2").Select
                Sheets("To").Select             ' -- select sheet (To)
            End If
        End If
    End Sub
    
    ' ---[Function] get source Column in sheet(From)
    Private Function fnc_FirstColumn() As Integer
        Dim firstCol As Integer
        Dim myCol As Integer
        For myCol = 3 To 100    ' -- supposing: last column = 100
            If (Cells(1, myCol).Value <> "") Then
                firstCol = myCol
                'MsgBox "firstCol=" & firstCol
                fnc_FirstColumn = myCol
                Exit Function
            End If
        Next
    End Function
    
    ' --- move from (From) to (To): actually copy and delete
    Private Sub prc_MoveValue(ByVal sourceCol As Integer)
        Dim targetCol As Integer
        ' --- search first blank column in (To): = targetCol
        Dim myCol As Integer
        For myCol = 1 To 100
            If (Sheets("To").Cells(1, myCol).Value = "") Then
                targetCol = myCol
                Exit For
            End If
        Next
        ' --- copy (From) to (To)
        Sheets("From").Columns(sourceCol).Copy _
            Sheets("To").Cells(1, targetCol)
        ' --- delete column in Source
        Sheets("From").Columns(sourceCol).Delete
    End Sub
    
    If you want a sample nearer to your sheets, please share it via cloud storage (e.g. OneDrive, Dropbox, etc).

    Regards,

    Ashidacchi

    Friday, February 23, 2018 5:07 AM
  • Hi, 

    Just checking in to see if the information was helpful. Please let us know if you would like further assistance.

    Regards,

    Emi


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.


    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Teams.

    Wednesday, February 28, 2018 10:07 AM
  • Hi,

    If you have any questions with the previous information I've provided, please don't hesitate to let me know. I am glad to be of assistance. 

    Regards,

    Emi


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.


    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Teams.

    Friday, March 2, 2018 10:32 AM