Copy And Paste Rows When Condition is Met VBA

[Lance S]

I'm struggling to make the code I have work for the below. For anything in column J that returns "Yes", I want the entire row to to be copied and pasted in another sheet starting at row 4 on the new sheet. After executing, I want the original row on the original sheet to then be deleted and for the code to the continuously execute until the data in cell A is empty.

This is what I have so far. I run into an issue with the line VLV.Cells(Rows.Count, "J").End (xlUp) + 4 = ActiveCell.Row (I know this line is completely wrong but I'm not sure how to fix)

ub VPLTest()

Application.ScreenUpdating = False

Activesheet.Unprotect Password:="purc"

Dim VLV As Worksheet
Dim PCF As Worksheet
Set VLV = Activesheet

Sheets.Add after:=Activesheet
Activesheet.Name = "PCF Items"

Set PCF = Activesheet

VLV.Range("A1:N4").Copy PCF.Range("A1:N4")

VLV.Select
VLV.Range("J5").Select

Do Until ActiveCell = ""
If ActiveCell.Value = "Yes" Then
VLV.Cells(Rows.Count, "J").End (xlUp) + 4 = ActiveCell.Row
End If
If ActiveCell = "Yes" Then EntireRow.Delete

Loop

 

[Lance S]

This is GREAT!

Couple questions for you.

1.) I'm a beginner at VBA as you can probably tell by how basic my coding is. I noticed you set SourceSheetName as "VLV" but then didn't call to "VLV" any where in the code. I'm not 100% sure what strings do so I could just be missing something?
2.) I want to add some last touch formatting to ("PCF Items") but adding it under the Next line give me a debug error. Looks like it breaks itself after running the action on the first row and just continues on to the formatting portion. Again, not sure what For/Next do so I'm more than likely doing this wrong. Here's the formatting I'd like to add to ("PCF Items") at the end (just before re-protecting the sheet)

Columns("A:A").ColumnWidth = 20
Columns("B:E").ColumnWidth = 12
Columns("F:F").ColumnWidth = 30
Columns("G:N").ColumnWidth = 12
Rows("4:4").Select
Range("A3:N").End(xlDown).Select
Selection.EntireRow.AutoFit
Rows("4:4").Select
Selection.AutoFilter

 

[johnnyL]

What are you trying to do with:

Rows("4:4").Select
Range("A3:N").End(xlDown).Select
Selection.EntireRow.AutoFit

?

 

[Lance S]

What are you trying to do with:

Rows("4:4").Select
Range("A3:N").End(xlDown).Select
Selection.EntireRow.AutoFit

?

I'm looking to select all rows from row 3 down on sheet ("PCF Items") and autofit them. The number of rows won't always be the same. Maybe I should just use LastRow here?

 

[johnnyL]

And then you want to AutoFilter Row 4 after that?

 

[Lance S]

And then you want to AutoFilter Row 4 after that?

Yes sir!

 

[johnnyL]

Got it. Gimme a few minutes.

 

[johnnyL]

This is GREAT!

Couple questions for you.

I noticed you set SourceSheetName as "VLV" but then didn't call to "VLV" any where in the code. I'm not 100% sure what strings do so I could just be missing something?

I gave you some variables, 'SourceSheetName' in this instance, to make it easier for you to make changes later on to the code. Instead of having to look for every place in the code that uses that sheet name, all you have to do is change the name in one location at the top of the code, from then on, the code uses 'SourceSheetName' in place of the 'vlv' sheet name. That is why you don't see the 'vlv' used anywhere else in the code, because the code is using the variable called 'SourceSheetName'. That explain it? If not let me know.

Ok, here is the latest version of the code:

Sub VPLTestV2()
'
    Dim CurrentRow              As Long
    Dim LastRow                 As Long
    Dim DestinationSheetName    As String
    Dim SourceSheetName         As String
    Dim SourceSheetPassword     As String
'
    DestinationSheetName = "PCF Items"                                              ' <--- Set this to name of the Destination sheet (the new sheet)
    SourceSheetName = "VLV"                                                         ' <--- Set this to name of the Source sheet
    SourceSheetPassword = "purc"                                                    ' <--- Set this to unprotect password of the Source sheet
'
    Application.ScreenUpdating = False                                              ' Turn ScreenUpdating off to prevent screen flicker
'
    Sheets(SourceSheetName).Unprotect Password:=SourceSheetPassword                 ' unprotect the Source sheet
'
    Sheets.Add after:=Sheets(SourceSheetName)                                       ' Add a new sheet after the Source sheet
    ActiveSheet.Name = DestinationSheetName                                         ' Assign a name to newly created sheet
'
    Sheets(SourceSheetName).Range("A1:N4").Copy Sheets(DestinationSheetName).Range("A1:N4") ' Copy Header rows from Source sheet to the new sheet
'
    LastRow = Sheets(SourceSheetName).Range("A" & Rows.Count).End(xlUp).Row         ' Determine Last used row in column A of the Source sheet
'
    For CurrentRow = LastRow To 5 Step -1                                           ' Start at LastRow and work backwards, row by row, until beginning of data
        If Sheets(SourceSheetName).Range("J" & CurrentRow).Value Like "*Yes*" Then  '   If we encounter a 'Yes' in column J then copy the row to new sheet
            Sheets(SourceSheetName).Rows(CurrentRow).Copy Sheets(DestinationSheetName).Range("A" & Rows.Count).End(xlUp).Offset(1)
            Sheets(SourceSheetName).Rows(CurrentRow).Delete                         '   Delete the row from the Source sheet that contained 'Yes' in column J
        End If
    Next                                                                            ' Continue checking previous row
'
    LastRow = Sheets(DestinationSheetName).Range("A" & Rows.Count).End(xlUp).Row    ' Determine Last used row in column A
'
    Sheets(DestinationSheetName).Columns("A").ColumnWidth = 20                      ' Set Column A width to 20
    Sheets(DestinationSheetName).Columns("B:E").ColumnWidth = 12                    ' Set Columns B:E & G:N widths to 12
    Sheets(DestinationSheetName).Columns("F").ColumnWidth = 30                      ' Set column F width to 30
    Sheets(DestinationSheetName).Columns("G:N").ColumnWidth = 12                    ' Set columns G:N width to 12
'
    Sheets(DestinationSheetName).Range("A3:A" & LastRow).Rows.AutoFit               ' AutoFit all rows from A3 and downward
    Sheets(DestinationSheetName).Rows(4).AutoFilter                                 ' AutoFilter Row 4
'
    Sheets(SourceSheetName).Protect Password:=SourceSheetPassword                   ' protect the Source sheet
'
    Application.ScreenUpdating = True                                               ' Turn ScreenUpdating back on
End Sub

I included a couple more variables in there also at the top to make it easier to change those if need be. Let us know how it works out for you.

 

[Lance S]

This worked perfectly! Thank you so much!

 

[johnnyL]

Your welcome @Lance S.