Announcement

Collapse
No announcement yet.

VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA Cut and Paste Row to Sheet2 if cell equals "Yes"



    Hi there,

    Firstly, apologies if this has already been outlined elsewhere and I have overlooked it.

    I am trying to write a VBA script to run a macro to carry out the following task:

    When "Button1" is pressed (named "Update,") column "I" is checked for cells that have a value of "Yes" (which is selected from a drop-down list, which takes it's options from a hidden column on the same sheet.) If a cell with the value of "Yes" is found in any of the cells in column "I", then it will cut cells A-I in the relevant row, paste the data in the next blank row on sheet2, then delete the selected row from sheet one and move the cells up so there is no blank row left.

    So far I have the following code for the macro for cutting and pasting etc:

    Code:
    Sub macro()
    
    
    If Selection.Value = "Yes" Then
    
    
        Range(Row = 5).Select
        Selection.Cut
        Sheets("Scotts").Select
        Range("A5:I5").Select
        Selection.Insert shift:=xlDown
        Sheets("Engineering").Select
        Selection.Delete shift:=xlUp
        MsgBox ("Record Updated")
    
    
    End If
    
    
    End Sub
    This works but only for the first row - it will run through the script once, move the necessary row and delete/shift up the cells but, if the data in cell I5 is blank, it doesn't run - I would like it to run through the entirety of the sheet and cut/paste the necessary rows. I have attempted to use a loop with a "do until selection.value = """ but again it will stop when it reaches an empty cell in column I.

    Does anyone have any ideas please on how this can be achieved?

    Thanks

  • #2
    Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

    Try this:

    Code:
    Option Explicit
    
    Sub Button1_Click()
    
        Dim i As Long
        
        For i = Cells(Rows.Count, 9).End(xlUp).Row To 1 Step -1
            If Cells(i, 9) = "Yes" Then
                Range("a" & i & ":I" & i).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Cells(i, 9).EntireRow.Delete
            End If
        Next
         
    End Sub
    It needs to go in the Worksheet Object Module. Coy the above code, right click the tab for the sheet that has the 'Update' button, click View Code and paste into the VBA window.
    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

    Comment


    • #3
      Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

      This might be faster than looping.
      Code goes in a regular module. Try it on a copy of your workbook first.
      Code:
      Sub Maybe()
          Application.ScreenUpdating = False
          Range("I1:I" & Range("I" & Rows.Count).End(3)(1).Row).AutoFilter 1, "Yes"
          Range("A2:I" & Range("A" & Rows.Count).End(3)(1).Row).SpecialCells(xlCellTypeVisible).Copy _
                  Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
          Range("A2:I" & Range("A" & Rows.Count).End(3)(1).Row).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
          ActiveSheet.AutoFilterMode = False
          Application.ScreenUpdating = True
      End Sub
      You could add this after the "Application.ScreenUpdating = False" line
      Code:
      If Application.WorksheetFunction.CountIf(Range("I1:I" & Range("I" & Rows.Count).End(3)(1).Row), "Yes") = 0 Then _
      MsgBox "No Yesses in Column I!": Exit Sub
      in case there are no cells with "Yes" in Column I.
      Last edited by jolivanes; June 14th, 2014, 01:44. Reason: added info

      Comment


      • #4
        Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

        Thanks, jolivanes, you are quite right, using autofilter is faster.

        It is better practice to use a Button_Click procedure in the worksheet object module rather than assigning a procedure in a standard module to a command button. Also better to use the code name for a sheet (Sheet2) rather than the tab name (Sheets("Sheet2")).

        When using autofilter there is no need to refer to SpecialCells(xlCellTypeVisible)

        The code can be reduced to this, put in the worksheet object module:

        Code:
        Sub Button1_Click()
        
            Application.ScreenUpdating = False
            Columns(9).AutoFilter 1, "Yes"
            With Range("a2", Range("i" & Rows.Count).End(3))
                .Copy Sheet2.Cells(Rows.Count, 1).End(3)(1)
                .EntireRow.Delete
            End With
            Columns(9).AutoFilter
            Application.ScreenUpdating = True
            
        End Sub
        This assumes Row 1 to be header row and data in rows 2 down
        We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

        Comment


        • #5
          Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

          @KjBox
          Good points.
          Where in Borneo?

          Comment


          • #6
            Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

            An island in South East Asia, part Malaysia, part Indonesia and part Brunei.
            We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

            Comment


            • #7
              Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

              My question was not where Borneo is situated but rather where you live in Borneo.
              I lived there in the seventies (Miri and Lutong)

              Comment


              • #8
                Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                Originally posted by KjBox View Post
                Try this:

                Code:
                Option Explicit
                
                Sub Button1_Click()
                
                    Dim i As Long
                    
                    For i = Cells(Rows.Count, 9).End(xlUp).Row To 1 Step -1
                        If Cells(i, 9) = "Yes" Then
                            Range("a" & i & ":I" & i).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                            Cells(i, 9).EntireRow.Delete
                        End If
                    Next
                     
                End Sub
                It needs to go in the Worksheet Object Module. Coy the above code, right click the tab for the sheet that has the 'Update' button, click View Code and paste into the VBA window.

                This works perfectly! Thanks KJBox!

                The Autofilter VBA codes don't seem to like working for some reason; when the macro runs, it unhides all my hidden rows before pasting the data onto the header row of sheet2, deleting any information that was there previously (i'd prefer it to shift the rows down when pasting and up when deleting.)

                One last question - what are the variables that need changing in the above code should I need to modify it to copy data from sheet2 to sheet3 with a different set of criteria? I've tried F8-ing along the code in the VB editor to find out what is doing what, but it doesn't seem to show any live progress in the spreadsheet.

                Comment


                • #9
                  Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                  The code works as follows:

                  the variable i is given a value that is the row number of the last used row in column A

                  Code:
                  If Cells(i, 9) = "Yes"
                  This checks if the cell in column I ( the 9th column, hence the 9) has a value equal to "Yes"

                  If that is true then cells A to I for that row are copied to the first available row in sheet 2, and that entire row on Sheet1 is deleted.

                  The code then moves on to the next value for i , this will be 1 less than the current value ( that is set by the Step -1 statement.

                  The above is repeated for for the new value for i, so he row concerned is the second up from the bottom.

                  This loop continues until i =1, which would be the first row.

                  The reason for starting at the bottom and moving up is because of the deletion of rows, if the loop is started with the top row then, when a row is deleted the value of i no longer refers to the row that has just been checked, so when a new value for i is assigned it would mean that an entire row would be missed in the check. Hard to explain but I hope that makes sense!

                  If there is no row deletion involved then looping from the top down is the usual approach.

                  Hopefully that will give you enough information to be able to adapt the code for a different set of worksheets.
                  We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                  Comment


                  • #10
                    Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                    I made an error in the code for the autofilter method, sorry, it is a much more efficient method (especially with large amounts of data.

                    Try this, it will no longer overwrite existing data on Sheet2. If you shift down after row deletion then you are going to end up with a bunch of empty rows at the top of your worksheet!

                    Code:
                    Sub Button1_Click()
                         
                        Application.ScreenUpdating = False
                        Columns(9).AutoFilter 1, "Yes"
                        With Range("a2", Range("i" & Rows.Count).End(3))
                            .Copy Sheet2.Cells(Rows.Count, 1).End(3).Offset(1)
                            .EntireRow.Delete
                        End With
                        Columns(9).AutoFilter
                        Application.ScreenUpdating = True
                         
                    End Sub
                    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                    Comment


                    • #11
                      Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                      Originally posted by KjBox View Post
                      I made an error in the code for the autofilter method, sorry, it is a much more efficient method (especially with large amounts of data.

                      Try this, it will no longer overwrite existing data on Sheet2. If you shift down after row deletion then you are going to end up with a bunch of empty rows at the top of your worksheet!

                      Code:
                      Sub Button1_Click()
                           
                          Application.ScreenUpdating = False
                          Columns(9).AutoFilter 1, "Yes"
                          With Range("a2", Range("i" & Rows.Count).End(3))
                              .Copy Sheet2.Cells(Rows.Count, 1).End(3).Offset(1)
                              .EntireRow.Delete
                          End With
                          Columns(9).AutoFilter
                          Application.ScreenUpdating = True
                           
                      End Sub
                      Thanks KJBox, works like a dream!

                      Sorry to ask but again, could you please break the code down so I understand what each line does (then at least I can actually learn the coding rather than relying on, super-knowledgeable VBA gurus to code for me?!)

                      Comment


                      • #12
                        Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                        Code:
                        Sub Button1_Click()
                             
                            Application.ScreenUpdating = False
                            Columns(9).AutoFilter 1, "Yes"                          '// Aplies an autofilter to the 9th column (Col I), filters for value "Yes"
                            With Range("a2", Range("i" & Rows.Count).End(3))        '// This range is all the data, when using autofilter no need to specify visible cells
                                .Copy Sheet2.Cells(Rows.Count, 1).End(3).Offset(1)  '// Copies all the rows on Sheet1 which were filtered, pastes to first available row on Sheet2
                                .EntireRow.Delete                                   '// Deletes all the rows on Sheet1 which were filtered
                            End With
                            Columns(9).AutoFilter                                   '// Removes the autofilter
                            Application.ScreenUpdating = True
                             
                        End Sub
                        You can use f8 to step through this code and you will see the changes taking place.
                        We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                        Comment


                        • #13
                          Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                          Originally posted by KjBox View Post
                          Code:
                          Sub Button1_Click()
                               
                              Application.ScreenUpdating = False
                              Columns(9).AutoFilter 1, "Yes"                          '// Aplies an autofilter to the 9th column (Col I), filters for value "Yes"
                              With Range("a2", Range("i" & Rows.Count).End(3))        '// This range is all the data, when using autofilter no need to specify visible cells
                                  .Copy Sheet2.Cells(Rows.Count, 1).End(3).Offset(1)  '// Copies all the rows on Sheet1 which were filtered, pastes to first available row on Sheet2
                                  .EntireRow.Delete                                   '// Deletes all the rows on Sheet1 which were filtered
                              End With
                              Columns(9).AutoFilter                                   '// Removes the autofilter
                              Application.ScreenUpdating = True
                               
                          End Sub
                          You can use f8 to step through this code and you will see the changes taking place.
                          Brill, thanks for your help

                          Comment


                          • #14
                            Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                            Originally posted by scotty33 View Post
                            Brill, thanks for your help
                            I spoke too soon!! :/

                            On sheet1 it works fine, filters the data correctly, cuts the rows which contain "Yes" in Column I.

                            I have used the same format on the other sheets though to change the variables that the code is working with and it seems to be deleting the physical rows from the sheet (I.e, removing the full row rather than the data so that I can't even "unhide" the rows.)

                            Here is the modified code I have used on sheet2:

                            Code:
                            Sub Button67_Click()
                                 
                                Application.ScreenUpdating = False
                                Columns(10).AutoFilter 1, (">397800000") 'Applies an autofilter to the 10th column (Col J), filters for value >397800000
                                With Range("a22", Range("j" & Rows.Count).End(3)) 'Ranges all the data - when using autofilter there is no need to specify visible cells
                                    .Copy Sheet3.Cells(Rows.Count, 1).End(3).Offset(1) 'Copies all the rows on sheet2 which were filtered, pastes them to the next available row on sheet3
                                    .EntireRow.Delete 'Deletes all the rows on sheet2 which were filtered
                                End With
                                Columns(10).AutoFilter 'Removes the autofilter
                                Application.ScreenUpdating = True
                                 
                            End Sub
                            As I said previously, I have around 18-20 rows at the top of the sheet which are hidden (they contain data for drop-down lists for a couple of columns.) I could simply move this data onto a hidden sheet but I'm not sure if that is what is causing the rows themselves to be removed from the sheet.

                            Any suggestions?

                            Comment


                            • #15


                              Re: VBA Cut and Paste Row to Sheet2 if cell equals "Yes"

                              Yes, get rid of those hidden rows.

                              If they contain lists then put the lists in a single column, well to the left of your data, place them under each other in a single column (you can leave a couple of blank cells between each list). Then give each range that contains a list a defined name. You can then hide the column.

                              Used the defined name to call on a list when it is needed for validation or drop down lists.

                              Data should always start in row 2 column A, with row 1 being used for headers.
                              We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                              Comment

                              Working...
                              X