Loop through Column B for Specific value

please help me edit this code to pertain to my file, essentially this should do what i want just needs to be formated for my file.

i need the file to look through all of column "B" find the cells that have "PA" displayed in column B and then copy that rows data to a new sheet. if possible for all tabs in file one for each day of the year.

thank you in advance.

Sub FIND_TEST3()
Dim n1 As String
Dim Wks As Worksheet
Dim c As Range
Dim firstAddress As String
Dim DestCell As Range

Set Wks = Worksheets("IRS Commission")
n1 = Sheets("Employee Data Entry").Range("D2").Value

With Wks
With .Range("I1").EntireColumn
    Set c = .Cells.find(What:=n1, _
    after:=.Cells(.Cells.Count), _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False)
    
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            With Worksheets(n1)
                Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
            c.EntireRow.Copy _
            Destination:=DestCell
            Set c = .FindNext(c)
                        
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End With
End Sub

Welcome to the forum. Unfortunately a couple of rules violations need to be resolved.

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.



Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(I have added them for you today. Please read all Forum Rules and comply in the future.)

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution.

Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.

To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

I would suggest that you use something akin to "Loop through Column B for Specific Values." Someone trying to search this forum would never get a hit using the changed or original title. I will change it for you this time, but in the future, please be more specific in your title. Think of how you would search for an answer in Google.

Im sorry, but I dont see how : Need Help editing code" is any more descriptive than "help with code"?

Gforeman, try this. I made a lot of assumptions, like how many columns you want to copy from the rows on each sheet that contain "PA". Anyhow, I decided to copy A:G, but you can change that. I'm putting them in a sheet called "Master" that will be created. I'll work on editing the code you provided, but maybe you could also provide your workbook, so we don't have to guess at sheet names.

Sub FindPA()

    Dim WS As Worksheet
    Dim WSMaster As Worksheet
    Dim rng As Range
    Dim c As Variant
    Dim CDest As Range
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    
    Worksheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Master"
    Set WSMaster = Worksheets("Master")
    WSMaster.Cells(1, 1).Value = "PA DATA"
    
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Name <> "Master" Then
            Set rng = WS.Range("B1:B" & WS.Range("B" & Rows.Count).End(xlUp).Row)
            With WSMaster
                For Each c In rng
                    If c.Value Like "*PA*" Then
                        LastRow = WSMaster.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                        Set CDest = WSMaster.Range("A" & LastRow)
                        
                        ' Im just gussing at the columns you want to copy
                        WS.Range("A" & c.Row & ":G" & c.Row).Copy Destination:=CDest
                    End If
                Next c
            End With
        End If
    Next WS
    
    Application.ScreenUpdating = True

End Sub

Greg

Hey Greg thank you so much for your help, the sheet names start with Jan 1, Jan 2, Jan 3 for the rest of the year Feb Mar etc.. the code is mostly working i have attached the error for you to see.

again thank you so much this is such a huge help.

Also the only columns i need coppied are A and B

I'll have to investigate the error you are seeing, as I can't re-produce it on either my Windows 7 or XP machines, both of which are running Office 2007. In any event, I tweaked it to only copy columns A and B.

Sub FindPA()

    Dim WS As Worksheet
    Dim WSMaster As Worksheet
    Dim rng As Range
    Dim rCell As Range
    Dim c As Variant
    Dim CDest As Range
    Dim LastRow As Long
    Dim i As Long
    Dim CheckExists As Boolean
    
    Application.ScreenUpdating = False
    
    CheckExists = False
    For i = 1 To Worksheets.Count Step 1
        If Sheets(i).Name = "Master" Then
            CheckExists = True
        End If
    Next i
    
    If CheckExists = False Then
        Worksheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "Master"
        Set WSMaster = Worksheets("Master")
        WSMaster.Cells(1, 1).Value = "PA DATA"
    Else
        MsgBox "Master already exists"
        Exit Sub
    End If
    
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Name <> "Master" Then
            Set rng = WS.Range("B1:B" & WS.Range("B" & Rows.Count).End(xlUp).Row)
            With WSMaster
                For Each c In rng
                    If c.Value Like "*PA*" Then
                        LastRow = WSMaster.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                        Set CDest = WSMaster.Range("A" & LastRow)
                        WS.Range("A" & c.Row & ":B" & c.Row).Copy Destination:=CDest
                    End If
                Next c
            End With
        End If
    Next WS
    
    Application.ScreenUpdating = True

End Sub

Greg