Trying to get a VBA to copy entire rows containing a specific value in one column

[PizzaBoxWings]

Hello, I have looked through quite a few posts already and some of the code provided is a little funky and I cannot quite figure out how to adjust it to suit what I need.

I have a worksheet "sheet5" with data subtotaled. I want to copy only rows which contain either "3" or "3 total" in column C and have it paste the data into "Sheet6" with out rows and rows of spaces between the data. there are over 2000 rows and probably only 500 contain the specific criteria for the transfer.

at the moment this is the code I am using. The data containing "3" in column C is transferring over but i cannot get the rows which contain "3 total" in column C to also make their way to the new sheet. there are also many, many rows between each transferred set of data.

thanks again in advance and sorry if i am not very clear i am still very new to this forum and to VBAs

Sub transfer_only_march_data()

Dim wsO As Worksheet, wsE As Worksheet
Dim LR As Long, i As Long
Set wsO = Sheets("sheet5")
Set wsE = Sheets("sheet6")
LR = wsO.Cells(Rows.Count, 1).End(xlUp).Row
With wsE
    For i = 2 To .Cells(Rows.Count, 3).End(xlUp).Row
        If .Cells(i, 3).Valuecontains = "3" Then
            .Rows(i).Copy wsO.Rows(LR + 1)
            LR = LR + 1
        End If
    Next
End With
End Sub

 

[gordsky]

Hi cant see any reason why you would get gaps in your data transfer but to solve you "3 total" issue change this line

If .Cells(i, 3).Valuecontains = "3" Then

for this

If .Cells(i, 3) like "*3*" Then

 

[MARK858]

See if the code below does what you want

Sub transfer_only_march_data()

    Dim wsO As Worksheet, wsE As Worksheet

    Set wsO = Sheets("sheet5")
    Set wsE = Sheets("sheet6")


    With wsE.Range("C1:C" & wsE.Range("C" & Rows.Count).End(xlUp).Row)
  
    .AutoFilter Field:=1, Criteria1:="3", _
        Operator:=xlOr, Criteria2:="3 total"

        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy _
        wsO.Range("A" & Rows.Count).End(xlUp).Offset(1)
        On Error GoTo 0
        .AutoFilter
  
    End With


End Sub

 

[PizzaBoxWings]

Dim wsO As Worksheet, wsE As Worksheet Set wsO = Sheets("sheet5") Set wsE = Sheets("sheet6") With wsE.Range("C1:C" & wsE.Range("C" & Rows.Count).End(xlUp).Row) .AutoFilter Field:=1, Criteria1:="3", _ Operator:=xlOr, Criteria2:="3 total" On Error Resume Next .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy _ wsO.Range("A" & Rows.Count).End(xlUp).Offset(1) On Error GoTo 0 .AutoFilter End With End Sub

Thank you so very much for this. Unfortunately, part of the code is coming back as an error:

  .AutoFilter Field:=1, Criteria1:="3", _
        Operator:=xlOr, Criteria2:="3 total"

I attempted changing it, but who am I kidding I have no clue what im doing with these codes.
any additional input or help would be greatly appreciated!

 

[MARK858]

There is no error on that line for me, did you copy/paste the code or re-type it?
What happens when you run the code in the workbook in the link below?
What error does the message state (you should always tell us this)?
Edit: Do you already have a filter applied or any protection on the workbook?

Pizzabox.xlsm | Powered by Box

app.box.com

 

[PizzaBoxWings]

There is no error on that line for me, did you copy/paste the code or re-type it?
What happens when you run the code in the workbook in the link below?
What error does the message state (you should always tell us this)?
Edit: Do you already have a filter applied or any protection on the workbook?

Pizzabox.xlsm | Powered by Box

app.box.com

thanks for your reply, i copy & pasted the code you provided.

I don't have any filter applied or protections to the worksheet

the error I am getting back is:

run time error '1004'
autofilter method of range class failed

 

[MARK858]

and what happened when you ran the code in the file in the link that I provided? do you have merged cells? Is Cell C1 blank?

 

[PizzaBoxWings]

and what happened when you ran the code in the file in the link that I provided? do you have merged cells? Is Cell C1 blank?

Hey,
i am not sure how to open up a module in the link you provided to check. i am sorry.

 

[PizzaBoxWings]

there are no merged cells and C1 is not blank

 

[MARK858]

i am not sure how to open up a module in the link you provided to check. i am sorry.

You click the download button, save the file, make sure it is unblocked as it is a download (right click the file, click properties and on the General tab if there is a security message near the bottom check the Unblock checkbox).
Open the file and then run the macro from the editor as you normally would.