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

N3ilG

New Member
Joined
Jun 7, 2015
Messages
11
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
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Hi - apologies, I also note I should have surrounded my code. I see that now - but was so frustrated.
 
Upvote 0
Yeah 680. Sorry.

This uses the Advanced Filter feature to filter the data en masse then copy all the filtered data to sheet 2

Make sure the Data's header in cell Sheet1 A1 is the same same as the criteria header on Sheet3 A1. The Advanced Filter requires matching headers.

Code:
[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]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)
    
    [color=darkblue]If[/color] ws1.FilterMode [color=darkblue]Then[/color] ws1.ShowAllData
    
    ws2.UsedRange.ClearContents
    [color=green]'ws2.Activate[/color]
    
    ws1.Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=ws3.Range("A1", ws3.Range("A" & Rows.Count).End(xlUp)), _
        CopyToRange:=ws2.Range("A1")
        
    [color=darkblue]If[/color] ws1.FilterMode [color=darkblue]Then[/color] ws1.ShowAllData
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Last edited:
Upvote 0
Hi, thanks for your help, but apologies - I might have not explained myself too well, I want to filter by a single criteria, copy paste rows and then move on to next criteria row - does that make sense. Can it filter by all criteria at once ? what if the same string appears in a single field, will it copy twice ?.
Regards - Neil
 
Last edited:
Upvote 0
Hi - sorry for bleating on..........but I might not be explaining myself too well. I was using a wild card at the front and end of the search range as the matches aren't exact, and I meant if there was more than 1 criteria - would it pick it up on both filters. Hence why I thought a loop would be good. Having said that I'm amazed at the potential thus far.
Kind regards - Neil
 
Upvote 0
Advance Filter could handle the wildcards, but not the copy same result twice fro two matching criteria.

Back to Autofilter looping criteria.

Code:
[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]With[/color] .Range("A1:A" & lRow)
    
            [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] ws3.Range("A1", ws3.Range("A" & Rows.Count).End(xlUp))
                    
                .AutoFilter Field:=1, Criteria1:="=*" & cell.Value & "*"
                
                [color=darkblue]If[/color] Application.WorksheetFunction.CountA(ws2.Cells) <> 0 [color=darkblue]Then[/color]
                    NextRow = ws2.Cells.Find("*", , , , 1, 2).row + 1
                [color=darkblue]Else[/color]
                    NextRow = 1
                [color=darkblue]End[/color] [color=darkblue]If[/color]
                
                ws1.Rows("2:" & lRow).Copy Destination:=ws2.Rows(NextRow)
                    
            [color=darkblue]Next[/color] cell
        
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        
        .AutoFilterMode = [color=darkblue]False[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Man that rocks. It had me skipping round the room, and will be the basis of my vba learning as I'll start to understand how to construct things.

In your honour it'll be called SearchTextAlphaF.

One last query, and you can say "NO MORE", it pastes with hiding the non relevant rows, although I can overcome that.

Your an absolute star - thank you so much. I know you'll have heard it a hundred times, but one day I hope to help others too.

Again thank you !!
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,956
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top