vba filter, loop through criteria list, and post row values to different sheet.

[N3ilG]

Hi - here goes, fairly experienced excel user (2013), and slowly getting to grips with a bit of vba mainly copied off the net.
Hope I don't mess up this post, and upset anyone (too much)!!

I have a workbook - 3 sheets (1,2 &3)
1 is data
2 is for output.
3 is filter criteria (680 of them) not completely matching data in cell the filter operates on.

I have code to filter one set of the criteria (via cell ref and wildcards) at a time, but hope to loop through the list, and past the entire row for each filtered record. I've spent more hours than it would have taken me manually but I just can't give up.......any help will be much appreciated.

Code I have (author unknown) is as follows:-

Sub searchtext1()

Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim copyFrom As Range, c As Long, lr As Long, b1st As Boolean
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets(1) 'assumes raw data is always first sheet
Set ws2 = wb1.Worksheets(2)
Set ws3 = wb1.Worksheets(3)

Dim rng As Range
Dim row As Range
Dim cell As Range

'ws2.Cells.ClearContents

With ws1


.AutoFilterMode = False


lRow = .Range("A" & .Rows.Count).End(xlUp).row
With .Range("A1:A" & lRow)
.AutoFilter field:=1, Criteria1:="=*" & ws3.Range("A550") & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With


.AutoFilterMode = False
End With



'ws2.Cells.ClearContents


With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
Else
lRow = 1
End If

copyFrom.Copy .Rows(lRow)

End With

End Sub

Any help is much appreciated...

Neil

 

[AlphaFrog]

You're welcome. Thanks for the feedback.

it pastes with hiding the non relevant rows

That's because when some criteria have no matches, it then paste the hidden rows. This corrects for that.

[color=darkblue]Sub[/color] searchtext1()
    
    [color=darkblue]Dim[/color] ws1 [color=darkblue]As[/color] Worksheet, ws2 [color=darkblue]As[/color] Worksheet, ws3 [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] cell [color=darkblue]As[/color] Range, lRow [color=darkblue]As[/color] [color=darkblue]Long[/color], NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] ws1 = ThisWorkbook.Worksheets(1)    [color=green]'assumes raw data is always first sheet[/color]
    [color=darkblue]Set[/color] ws2 = ThisWorkbook.Worksheets(2)
    [color=darkblue]Set[/color] ws3 = ThisWorkbook.Worksheets(3)
    
    ws2.Cells.ClearContents
    
    [color=darkblue]With[/color] ws1
    
        .AutoFilterMode = [color=darkblue]False[/color]
        lRow = .Range("A" & .Rows.Count).End(xlUp).row
        
        [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] ws3.Range("A1", ws3.Range("A" & Rows.Count).End(xlUp))
                
            .Range("A1:A" & lRow).AutoFilter Field:=1, Criteria1:="=*" & cell.Value & "*"
            
            [color=darkblue]If[/color] .Range("A" & .Rows.Count).End(xlUp).row > 1 [color=darkblue]Then[/color]
                
                [color=darkblue]If[/color] Application.WorksheetFunction.CountA(ws2.Cells) <> 0 [color=darkblue]Then[/color]
                    NextRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).row + 1
                [color=darkblue]Else[/color]
                    NextRow = 1
                [color=darkblue]End[/color] [color=darkblue]If[/color]
                
                .Rows("2:" & lRow).Copy Destination:=ws2.Rows(NextRow)
                
            [color=darkblue]End[/color] [color=darkblue]If[/color]
                
        [color=darkblue]Next[/color] cell
        
        .AutoFilterMode = [color=darkblue]False[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]