0

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

2 Answers 2

2

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
Sign up to request clarification or add additional context in comments.

12 Comments

Sorry, no, there can be multiple lines with the value I am looking for. The value for Sector1 is set by a different process. So for this step I want to find all places between RngStart and RngStop where column D = Sector1 and, for those, copy Column G.
You sir, are a lifesaver!!!! It works perfectly. If I may ask one more question: could you help me with code so that it only copies (or pastes) when there is a valid value (not blank) in column G?
Hmmmm immediately after you do the first AutoFilter try applying a second filter to column G: rngToSearch.AutoFilter 4, Criteria1:="<>", Operator:=xlAnd
Hello - I have been with this code a lot, modifying it for different needs and I am running into the problem that sometimes there are no cells to copy (there is no Sector1 in that section). I have tried adding If RngToSearch.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then after the two autofilters (sector1 and blanks) assuming that it is >1 because RngToSeach includes the header (have also tried >0 and that doesn't work either). Any help is appreciated!
Error is "No cells were found" on line copyRange.SpecialCells(xlCellTypeVisible).Copy RngDest
|
1

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

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.