CODEWITHSUNDEEP
vba
spaindc
spaindc

Reputation: 361

VBA: Filter by a String Variable

Everything works in this code except for the Autofilter by the variable Sector1.

The idea is that the value in Sector1 (Dropdowns sheet cell B63) can vary. In the Review tab I want to search in column D of a specific section (between RngStart and RngStop) for the string value in Sector1. When it finds it, I want to copy the information in column G to the Mkting sheet starting at A16. I know this works because if instead of sector1 I put a valid Sector (e.g., "Health") in the code below, it works.However, with this code, it just copies everything in column G, without filtering for Sector1.

Sub test()

Dim RngDest As Range
Dim RngStart As Range, RngStop As Range
Dim Sector1 As String

    Sector1 = Sheets("Dropdowns").Range("B63").Value
    With Sheets("Mkting")
        Set RngDest = .Range("A16")
    End With

    Set RngStart = Sheets("Review").Columns("A").Find("Impact Statements", , xlValues, xlPart)
    Set RngStop = Sheets("Review").Columns("A").Find("Quotes", , xlValues, xlPart)

    With Sheets("Review").Range("D" & RngStart.row & ":" & "D" & RngStop.row)
        .AutoFilter 1, Criteria1:=Sector1
        .Offset(1, 3).Copy RngDest
        .AutoFilter
    End With
End Sub

Upvotes: 0

Views: 8720

Answers (2)

spaindc
spaindc

Reputation: 361

I am adding code to David's great answer to deal with the case where there what you are sorting on does not appear in your RngToSeach - that is, Sector1 is not in your range. David, I put together a lot of other things you have helped me with to come up with this. Thank you so much for your help!

Sub test()

Dim RngToSearch As Range
Dim RngDest As Range
Dim RngStart As Range, RngStop As Range
Dim copyRng As Range
Dim Sector1 As String
Dim foundRow As Variant

With Sheets("Mkting")
        Set RngDest = .Range("A80")
End With

Set RngStart = Sheets("Review").Columns("A").Find("Impact Statements", , xlValues, xlPart)
Set RngStop = Sheets("Review").Columns("A").Find("Quotes", , xlValues, xlPart)

Set RngToSearch = Sheets("Review").Range("D" & RngStart.row & ":G" & RngStop.row)
Set copyRng = RngToSearch.Offset(1, 3).Resize(RngToSearch.Rows.Count - 1, 1)

RngToSearch.AutoFilter 1, Criteria1:=Sector1
RngToSearch.AutoFilter 4, Criteria1:="<>"
If RngToSearch.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
    copyRng.SpecialCells(xlCellTypeVisible).Copy RngDest
ElseIf RngToSearch.SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then
    foundRow = Sheets("Review").Application.Match(Sector1, RngToSearch.Columns(1), False)
    If Not IsError(foundRow) Then
      RngToSearch.Cells(foundRow, 4).Copy RngDest
    End If
End If
RngToSearch.AutoFilter
End Sub

Upvotes: 1

David Zemens
David Zemens

Reputation: 53623

If you only are concerned about obtaining a single value (i.e., there is only one match to your AutoFilter then just use MATCH to return the relative position of the value you're searching for:

Dim foundRow as Variant
Dim rngToSearch as Range

'Define a range of column D:G, from start row to end row:
Set rngToSearch = Sheets("Review").Range("D" & RngStart.Row & ":G" & RngStop.Row)

'do a vlookup on that range
foundRow = Application.Match(Sector1, rngToSearch.Columns(1), False)

If not IsError(foundRow) Then
    rngToSearch.Cells(foundRow,1).Copy RngDest
End If

If there are multiple potential occurrences of the filtered value, then I think there are several approaches you could take, let's try which omits the header row (which would ordinarily be returned as part of the "filtered" range, unfortunately:

Dim rngToSearch as Range
Dim copyRange As Range

Set rngToSearch = Sheets("Review").Range("D" & RngStart.Row & ":G" & RngStop.Row)
'Get a single column range representing column G:
Set copyRange = rngToSearch.Offset(1, 3).Resize(rngToSearch.Rows.Count - 1, 1)

rngToSearch.AutoFilter 1, Criteria1:=Sector1

copyRange.SpecialCells(xlCellTypevisible).Copy rngDest

rngToSearch.AutoFilter 'Turn off the filter

To omit blanks from column G, do something like this immediately after you apply the first autofilter, add another one for column G:

rngToSearch.AutoFilter 4, Criteria1:="<>", Operator:=xlAnd

Here is my test version(using slightly different range/etc.), output to F2:

enter image description here

Sub test()
Dim rngToSearch As Range
Set rngToSearch = Range("A1:D8")

rngToSearch.AutoFilter 1, Criteria1:=2

rngToSearch.AutoFilter 4, Criteria1:="<>", Operator:=xlAnd

Dim copyRange As Range
Set copyRange = rngToSearch.Offset(1, 3).Resize(rngToSearch.Rows.Count - 1, 1)

If rngToSearch.SpecialCells(xlCellTypeVisible).Rows > 1 Then
    copyRange.SpecialCells(xlCellTypeVisible).Copy Range("F2")
End If

rngToSearch.AutoFilter

End Sub

Upvotes: 2

Related Questions